This notebook analyses both parts of the data in terms of variable importance, using a random forest model based on conditional inference trees and a conditional permutation variable importance algorithm.
# load packages
library(tidyr)
library(ggplot2)
library(party)
library(conflicted)
library(tidyverse)
library(openxlsx)
library(caret)
library(viridis)
library(cowplot)
library(permimp)
# set package parameters
theme_set(theme_bw())
# plot colour scheme
mycolourlist = list(c(0, 102, 255), c(0, 204, 153), c(255, 0, 102), c(74, 111, 152), c(251, 164, 49), c(204, 153, 255), c(90, 192, 255), c(80, 245, 233), c(255, 90, 192), c(164, 201, 242), c(255, 254, 139), c(255, 243, 255))
mycolours = matrix()
for (ii in 1:length(mycolourlist)){
mycolours[ii] = rgb(mycolourlist[[ii]][1]/255,
mycolourlist[[ii]][2]/255,
mycolourlist[[ii]][3]/255)
}
# toggle to save plots
saveplots = TRUE
if (saveplots){
# set output plot directory
choose.files(caption="Just cancel this", filters=matrix(data=c(" ", " "), ncol=2)) # workaround for bug in RTerm choose.dir
outFigPath <- utils::choose.dir(caption="Select output folder to save plots '03 Experiment\\Experiment 1\\Analysis\\Plots'")
if (!dir.exists(file.path(outFigPath, "svg"))){dir.create(file.path(outFigPath, "svg"))}
if (!dir.exists(file.path(outFigPath, "pdf"))){dir.create(file.path(outFigPath, "pdf"))}
}
# toggle to save data
savedata = TRUE
if (savedata){
# set output plot directory
if (saveplots==FALSE){
choose.files(caption="Just cancel this", filters=matrix(data=c(" ", " "), ncol=2)) # workaround for bug in RTerm choose.dir
}
outDataPath <- utils::choose.dir(caption="Select output folder to save data '03 Experiment\\Experiment 1\\Analysis\\R'")
}
stimDatapath <- utils::choose.files(caption=r"(Select refmap_listest1_testdata_ByStim.csv from 03 Experiment\Experiment 1\Analysis\PostProcess)",
filters=matrix(data=c("refmap_listest1_testdata_ByStim.csv", "refmap_listest1_testdata_ByStim.csv"), ncol=2))
stimData <- utils::read.csv(stimDatapath, header=TRUE)
colnames(stimData)[1] <- "Stimulus"
# make response proportions into percentages
stimData[['HighAnnoyPc']] <- stimData[['HighAnnoyProp']]*100
stimData[['dHighAnnoyPc']] <- stimData[['dHighAnnoyProp']]*100
# function to encode categorical to ordinal numeric variables
encode_ordinal <- function(x, order=unique(x)) {
x <- as.numeric(factor(x, levels=order, exclude=NULL, order=TRUE))
x
}
# definition of ordinal variable levels
SNRCats <- c("No UAS", "-16", "-10", "-4", "2", "8")
UASLAeqCats <- c("No UAS", "42", "48", "54", "60")
The aggregated data by stimulus are assigned to a dataframe, relevant categorical variables are converted to ordinal, and then the variable subset of interest is selected, NA rows dropped (ie, the ‘no UAS’ stimuli, as the conditional variable importance algorithm cannot currently handle NA values, which are present in all the UAS dB metrics), and a formula assigned.
stimDataNum <- data.frame()
stimDataNum <- cbind(stimData[, 'Stimulus'],
stimData[, "UASEvents"],
stimData[, which(colnames(stimData)=="UASLAeq"):
which(colnames(stimData)=="SNRlevel")],
stimData[, which(colnames(stimData)=="IntermitRatioC2MaxLR"):
which(colnames(stimData)=="IntermitRatioC5MaxLR")],
stimData[, which(colnames(stimData)=="UASLAEMaxLR"):
which(colnames(stimData)=="UASEPNLMaxLR")],
stimData[, which(colnames(stimData)=="UASLoudECMAPowAvgBin"):
which(colnames(stimData)=="UASLoudISO3PowAvgBin")],
stimData[, which(colnames(stimData)=="UASTonalECMAAvgMaxLR"):
which(colnames(stimData)=="UASSharpvBISO105ExBin")],
stimData[, which(colnames(stimData)=="UASImpulsSHMPowAvgMaxLR"):
which(colnames(stimData)=="UASPsychAnnoyBoucher")],
stimData[, which(colnames(stimData)=="LAeqLAF90diff"):
which(colnames(stimData)=="dPsychAnnoyBoucher")],
stimData[, which(colnames(stimData)=="ValenceMedian"):
which(colnames(stimData)=="dHighAnnoyProp")],
stimData[, which(colnames(stimData)=="HighAnnoyPc"):
which(colnames(stimData)=="dHighAnnoyPc")])
# remove duplicated variables
stimDataNum <- subset(stimDataNum, select = -c(UASLAeq))
colnames(stimDataNum)[1] <- "Stimulus"
colnames(stimDataNum)[2] <- "UASEvents"
# make the discrete ordinal outcome variables factors
stimDataNum[['UASEvents']] <- factor(stimDataNum[['UASEvents']], levels=c(0, 1, 3, 5, 9), order=TRUE)
stimDataNum[['ValenceMedian']] <- factor(stimDataNum[['ValenceMedian']], levels=c(1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5), order=TRUE)
stimDataNum[['ArousalMedian']] <- factor(stimDataNum[['ArousalMedian']], levels=c(1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5), order=TRUE)
stimDataNum[['AnnoyMedian']] <- factor(stimDataNum[['AnnoyMedian']], levels=c(0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5,
5.5, 6, 6.5, 7, 7.5, 8, 8.5, 9, 9.5, 10), order=TRUE)
stimDataNum[['dValenceMedian']] <- factor(stimDataNum[['dValenceMedian']], levels=c(-4, -3.5, -3, -2.5, -2, -1.5, -1, -0.5, 0,
0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4), order=TRUE)
stimDataNum[['dArousalMedian']] <- factor(stimDataNum[['dArousalMedian']], levels=c(-4, -3.5, -3, -2.5, -2, -1.5, -1, -0.5, 0,
0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4), order=TRUE)
stimDataNum[['dAnnoyMedian']] <- factor(stimDataNum[['dAnnoyMedian']], levels=c(-10, -9.5, -9, -8.5, -8, -7.5, -7, -6.5, -6, -5.5, -5,
-4.5, -4, -3.5, -3, -2.5, -2, -1.5, -1, -0.5,
0, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5,
5.5, 6, 6.5, 7, 7.5, 8, 8.5, 9, 9.5, 10), order=TRUE)
# omit ambient-only stimuli
stimDataNum <- stimDataNum |> dplyr::filter(UASEvents != 0)
stimDataNum$SNRlevel <- as.numeric(stimDataNum$SNRlevel)
Write a function to train a conditional-inference random forest (crf) model on input data according to input formula, iterate over input random seeds, average error and variable importance metrics, and output metrics with plotted
multi_crfReg <- function(dataIn, iVars, dVar, seeds, ntree, mtry, permImpCondThres=0.95, minsplit=20, minbucket=7, nperm=1){
# initialise variables
crfOOBErrAll <- 0
crfOOBRMSE <- 0
crfOOBMAE <- 0
crfOOBErrR2 <- 0
crfMarPermImpVals <- 0
crfConPermImpVals <- 0
crfMarPermImpValsPerTree <- data.frame()
crfConPermImpValsPerTree <- data.frame()
for (iters in 1:length(seeds)){
# formula for regression
formVars <- reformulate(iVars, dVar)
# set random seed
set.seed(seeds[iters])
# train crf model
crfModel <- party::cforest(formVars, data=dataIn,
controls=party::cforest_unbiased(ntree=ntree,
mtry=mtry,
minsplit=minsplit,
minbucket=minbucket))
# get OOB predictions
crfModelOOB <- predict(crfModel, OOB=TRUE, type='response')
# get OOB error
crfModelOOBErr <- as.numeric(as.matrix(as.numeric(as.matrix(crfModelOOB))
- as.numeric(as.matrix(crfModel@data@env$response[[names(crfModel@data@env$response)]]))))
# OOB RMSE, MAE and Rsquared
crfOOBRMSE <- crfOOBRMSE + sqrt(mean(crfModelOOBErr^2))
crfOOBMAE <- crfOOBMAE + mean(abs(crfModelOOBErr))
crfOOBErrR2 <- crfOOBErrR2 + cor(as.numeric(as.matrix(crfModelOOB)),
as.numeric(as.matrix(crfModel@data@env$response[[names(crfModel@data@env$response)]])))^2
# set random seed
set.seed(seeds[iters])
# set random seed
set.seed(seeds[iters])
# conditional variable permutation importance
crfConPermImp <- permimp::permimp(crfModel, nperm=nperm, conditional=TRUE, threshold=permImpCondThres, progressBar=FALSE)
crfConPermImpVals <- crfConPermImpVals + crfConPermImp$values
crfConPermImpValsPerTree <- rbind(crfConPermImpValsPerTree, crfConPermImp$perTree)
}
# average metrics
crfOOBErrAll <- crfOOBErrAll/length(seeds)
crfOOBRMSE <- crfOOBRMSE/length(seeds)
crfOOBMAE <- crfOOBMAE/length(seeds)
crfOOBErrR2 <- crfOOBErrR2/length(seeds)
crfConPermImpVals <- data.frame(CondPermImp=sort(crfConPermImpVals/length(seeds), decreasing=TRUE))
crfConPermImpValsQtl <- data.frame(apply(crfConPermImpValsPerTree, 2, quantile, probs=c(0.25, 0.50, 0.75)))
resultsOut <- list('OOB_RMSE'=crfOOBRMSE, 'OOB_MAE'=crfOOBMAE, 'Rsquared'=crfOOBErrR2, 'conditional_permimp'=crfConPermImpVals, 'conditional_permimp_perTree'=crfConPermImpValsPerTree, 'conditional_permimp_qtl'=crfConPermImpValsQtl)
return(resultsOut)
}
crfReg <- function(dataIn, iVars, dVar, seeds, ntree, mtry, permImpCondThres=0.95, minsplit=20, minbucket=7, nperm=1){
# initialise variables
crfOOBErrAll <- 0
crfOOBRMSE <- 0
crfOOBMAE <- 0
crfOOBErrR2 <- 0
crfMarPermImpVals <- 0
crfConPermImpVals <- 0
crfMarPermImpValsPerTree <- data.frame()
crfConPermImpValsPerTree <- data.frame()
# formula for regression
formVars <- reformulate(iVars, dVar)
for (iters in 1:length(seeds)){
# set random seed
set.seed(seeds[iters])
# train crf model
crfModel <- party::cforest(formVars, data=dataIn,
controls=party::cforest_unbiased(ntree=ntree,
mtry=mtry,
minsplit=minsplit,
minbucket=minbucket))
# conditional variable permutation importance
crfConPermImp <- permimp::permimp(crfModel, nperm=nperm, conditional=TRUE, threshold=permImpCondThres, progressBar=FALSE)
crfConPermImpVals <- crfConPermImp$values
if (iters == 1){
crfConPermImpVals1 <- data.frame(CondPermImp=sort(crfConPermImpVals, decreasing=TRUE))
crfConPermImpValsPerTree1 <- crfConPermImp$perTree
crfConPermImpValsQtl1 <- data.frame(apply(crfConPermImpValsPerTree1, 2, quantile, probs=c(0.25, 0.50, 0.75)))
# get OOB predictions
crfModelOOB <- predict(crfModel, OOB=TRUE, type='response')
# get OOB error
crfModelOOBErr <- as.numeric(as.matrix(as.numeric(as.matrix(crfModelOOB))
- as.numeric(as.matrix(crfModel@data@env$response[[names(crfModel@data@env$response)]]))))
# OOB RMSE, error quartiles and Rsquared
crfOOBRMSE <- sqrt(mean(crfModelOOBErr^2))
crfOOBMAE <- crfOOBMAE + mean(abs(crfModelOOBErr))
crfOOBErrR2 <- cor(as.numeric(as.matrix(crfModelOOB)),
as.numeric(as.matrix(crfModel@data@env$response[[names(crfModel@data@env$response)]])))^2
}
else{
crfConPermImpValsN <- data.frame(CondPermImp=sort(crfConPermImpVals, decreasing=TRUE))
nVarImpChecks <- min(max(sum(crfConPermImpVals1 >= crfConPermImpVals1$CondPermImp[1]*0.1),
sum(crfConPermImpValsN >= crfConPermImpValsN$CondPermImp[1]*0.1)), 4) # number of variable importance values with a value at least 10% of the highest importance
if (sum(rownames(crfConPermImpVals1)[1:nVarImpChecks] != rownames(crfConPermImpValsN)[1:nVarImpChecks]) > 0){
warning("Permutation importance rank order within 10% of max differs between seeds: increase number of trees ('ntree') or number of permutations ('nperm'), or subsample of features ('mtry')")
}
else{
resultsOut <- list('OOB_errors'=crfModelOOBErr, 'OOB_RMSE'=crfOOBRMSE, 'OOB_MAE'=crfOOBMAE, 'Rsquared'=crfOOBErrR2, 'conditional_permimp'=crfConPermImpVals1, 'conditional_permimp_perTree'=crfConPermImpValsPerTree1, 'conditional_permpimp_qtl'=crfConPermImpValsQtl1)
return(resultsOut)
}
}
}
}
mtryTune <- function(dataIn, iVars, dVar, seeds, ntrees, minsplit=20, minbucket=7){
formVars <- reformulate(iVars, dVar)
# set mtry values and corresponding iVars/mtry ratios
if (length(iVars) > 9){
iVars_mtrys <- c(10.5, 5.25, 3.5, 2.75, 2.25, 1.75, 1.5, 1.25)
mtrys <- as.integer(length(iVars)/iVars_mtrys)
}
else{
mtrys <- seq(2, length(iVars) - 3, by=1)
iVars_mtrys <- length(iVars)/mtrys
}
iVars_mtrys <- iVars_mtrys[mtrys >= 2] # remove 0 or 1 values
mtrys <- mtrys[mtrys >= 2] # remove 0 or 1 values
# remove any duplicated values
iVars_mtrys <- iVars_mtrys[!(duplicated(mtrys) | duplicated(mtrys, fromLast = TRUE))]
mtrys <- mtrys[!(duplicated(mtrys) | duplicated(mtrys, fromLast = TRUE))]
# ensure mtrys is less than length(iVars)
iVars_mtrys <- iVars_mtrys[mtrys < length(iVars)]
mtrys <- mtrys[mtrys < length(iVars)]
resRMSEMap = matrix(data=0, nrow=length(mtrys), ncol=length(ntrees))
resRsquaredMap = matrix(data=0, nrow=length(mtrys), ncol=length(ntrees))
resMAEMap = matrix(data=0, nrow=length(mtrys), ncol=length(ntrees))
for (ii in seq(1, length(ntrees))){
tuneMod.results <- data.frame(RMSE=numeric(length(mtrys)),
Rsquared=numeric(length(mtrys)),
MAE=numeric(length(mtrys)))
for (seed in seeds){
set.seed(seed)
ntree = ntrees[ii]
tuneMod <- caret::train(formVars,
data=dataIn,
method='cforest',
controls=party::cforest_unbiased(ntree=ntree,
minsplit=minsplit,
minbucket=minbucket),
tuneGrid=data.frame(.mtry=mtrys),
trControl = trainControl(method = "oob"))
# accumulate results
resRMSEMap[, ii] <- resRMSEMap[, ii] + tuneMod$results$RMSE
resRsquaredMap[, ii] <- resRsquaredMap[, ii] + tuneMod$results$Rsquared
resMAEMap[, ii] <- resMAEMap[, ii] + tuneMod$results$MAE
tuneMod.results <- tuneMod.results + tuneMod$results[, which(names(tuneMod$results) != 'mtry')]
}
# average results
tuneMod.results <- tuneMod.results/length(seeds)
tuneMod.results <- cbind(tuneMod.results, data.frame(mtry=mtrys), data.frame(iVars_mtry=iVars_mtrys))
print(tuneMod.results)
}
# average results
resRMSEMap <- resRMSEMap/length(seeds)
resRsquaredMap <- resRsquaredMap/length(seeds)
resMAEMap <- resMAEMap/length(seeds)
# convert to data frames with mtry as row names and ntree as column names, and convert to long format using tidyverse
resdfRMSEMap <- as.data.frame(resRMSEMap)
rownames(resdfRMSEMap) <- mtrys
colnames(resdfRMSEMap) <- ntrees
resdfRsquaredMap <- as.data.frame(resRsquaredMap)
rownames(resdfRsquaredMap) <- mtrys
colnames(resdfRsquaredMap) <- ntrees
resdfMAEMap <- as.data.frame(resMAEMap)
rownames(resdfMAEMap) <- mtrys
colnames(resdfMAEMap) <- ntrees
# convert dataframes to long format using tidyverse
resdfRMSEMap <- resdfRMSEMap |>
rownames_to_column('mtry') |>
gather(key='ntree', value='RMSE', -mtry)
resdfRsquaredMap <- resdfRsquaredMap |>
rownames_to_column('mtry') |>
gather(key='ntree', value='Rsquared', -mtry)
resdfMAEMap <- resdfMAEMap |>
rownames_to_column('mtry') |>
gather(key='ntree', value='MAE', -mtry)
# ensure ntree and mtry columns are ordered factors
resdfRMSEMap$ntree <- factor(resdfRMSEMap$ntree, levels=as.character(ntrees))
resdfRMSEMap$mtry <- factor(resdfRMSEMap$mtry, levels=as.character(mtrys))
resdfRsquaredMap$ntree <- factor(resdfRsquaredMap$ntree, levels=as.character(ntrees))
resdfRsquaredMap$mtry <- factor(resdfRsquaredMap$mtry, levels=as.character(mtrys))
resdfMAEMap$ntree <- factor(resdfMAEMap$ntree, levels=as.character(ntrees))
resdfMAEMap$mtry <- factor(resdfMAEMap$mtry, levels=as.character(mtrys))
# plot heatmaps using ggplot, with extreme (min or max) value plotted as overlaid point using annotate and colourbar scale reversed
pHeatmapRMSE <- ggplot(resdfRMSEMap) +
geom_tile(aes(x=ntree, y=mtry, fill=RMSE)) +
scale_fill_viridis(option="viridis", direction=-1) +
geom_point(data=resdfRMSEMap[which(resdfRMSEMap$RMSE
== min(resdfRMSEMap$RMSE),
arr.ind = TRUE),],
aes(x=ntree, y=mtry), colour="red", size=2) +
guides(colour = guide_colourbar(reverse=TRUE)) +
labs(x="ntree", y="mtry", fill="RMSE") +
theme(text = element_text(family = "serif"))
pHeatmapRsquared <- ggplot(resdfRsquaredMap) +
geom_tile(aes(x=ntree, y=mtry, fill=Rsquared)) +
scale_fill_viridis(option="viridis", direction=1) +
geom_point(data=resdfRsquaredMap[which(resdfRsquaredMap$Rsquared
== max(resdfRsquaredMap$Rsquared),
arr.ind = TRUE),],
aes(x=ntree, y=mtry), colour="red", size=2) +
guides(colour = guide_colourbar(reverse=TRUE)) +
labs(x="ntree", y="mtry", fill="Rsquared") +
theme(text = element_text(family = "serif"))
pHeatmapMAE <- ggplot(resdfMAEMap) +
geom_tile(aes(x=ntree, y=mtry, fill=MAE)) +
scale_fill_viridis(option="viridis", direction=-1) +
geom_point(data=resdfMAEMap[which(resdfMAEMap$MAE
== min(resdfMAEMap$MAE),
arr.ind = TRUE),],
aes(x=ntree, y=mtry), colour="red", size=2) +
guides(colour = guide_colourbar(reverse=TRUE)) +
labs(x="ntree", y="mtry", fill="MAE") +
theme(text = element_text(family = "serif"))
p <- cowplot::plot_grid(pHeatmapRMSE,
pHeatmapRsquared,
pHeatmapMAE,
ncol=3, nrow=1)
return(p)
} # end of function
permImpCondThres <- 0.95
minsplit <- 20
minbucket <- 7
ntrees <- c(251, 501, 1001, 1501, 2501, 4001, 5501)
eventVar <- "UASEvents"
ambVar <- "AmbientLAeq"
resdAnnoyMnFitAB <- data.frame(RMSE = numeric(),
MAE = numeric(),
Rsquared = numeric())
resdAnnoyMnPermImpAB <- list()
iVars <- names(stimDataNum)[which(names(stimDataNum) == 'UASEvents'):which(names(stimDataNum) == 'UASPsychAnnoyBoucher')]
iVars <- iVars[! iVars %in% c('SNRlevel', 'IntermitRatioC2MaxLR', 'IntermitRatioC3MaxLR', 'IntermitRatioC5MaxLR')]
dVar <- "dAnnoyMean"
seeds <- c(578312, 544, 84894, 54654, 153157)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsVarsHyperTune.svg", width=12, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsVarsHyperTune.svg")
ggsave(filename="PtsABdAnnoyMnAbsVarsHyperTune.pdf", width=12, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsVarsHyperTune.pdf")
}
Selected hyperparameters
ntree <- 2501
mtry <- as.integer(length(iVars)/1.75)
Train preliminary model
nperm <- 5
resultsOutAbs <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbs$OOB_RMSE
[1] 0.7179463
resultsOutAbs$OOB_MAE
[1] 0.5697517
resultsOutAbs$Rsquared
[1] 0.81913
Train multiple seeds model
resultsOutAbs <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbs$OOB_RMSE
[1] 0.7262005
resultsOutAbs$OOB_MAE
[1] 0.5771998
resultsOutAbs$Rsquared
[1] 0.8140447
# store results
resdAnnoyMnFitAB['Abs vars', 'RMSE'] <- resultsOutAbs$OOB_RMSE
resdAnnoyMnFitAB['Abs vars', 'MAE'] <- resultsOutAbs$OOB_MAE
resdAnnoyMnFitAB['Abs vars', 'Rsquared'] <- resultsOutAbs$Rsquared
resdAnnoyMnPermImpAB$AbsVars <- resultsOutAbs$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutAbs.conimp <- arrange(resultsOutAbs$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutAbs.conimp) + geom_col(aes(x=factor(rownames(resultsOutAbs.conimp), levels=rownames(resultsOutAbs.conimp)), y=CondPermImp), fill=mycolours[1], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) +
coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsVarsConPermimp.svg", width=8, height=13, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsVarsConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAbsVarsConPermimp.pdf", width=8, height=13, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsVarsConPermimp.pdf")
}
# Plot only positive values
resultsOutAbs.conimpPtv <- resultsOutAbs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > 0)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbs.conimpPtv) + geom_col(aes(x=factor(rownames(resultsOutAbs.conimpPtv), levels=rownames(resultsOutAbs.conimpPtv)), y=CondPermImp), fill=mycolours[1], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsVarsConPermimpPtv.svg", width=8, height=10, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsVarsConPermimpPtv.svg")
ggsave(filename="PtsABdAnnoyMnAbsVarsConPermimpPtv.pdf", width=8, height=10, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsVarsConPermimpPtv.pdf")
}
# Plot only values within 1% of the maximum
resultsOutAbs.conimp1pc <- resultsOutAbs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > max(resultsOutAbs.conimp)/100)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbs.conimp1pc) + geom_col(aes(x=factor(rownames(resultsOutAbs.conimp1pc), levels=rownames(resultsOutAbs.conimp1pc)), y=CondPermImp), fill=mycolours[1], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsVarsConPermimp1pc.svg", width=8, height=3, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsVarsConPermimp1pc.svg")
ggsave(filename="PtsABdAnnoyMnAbsVarsConPermimp1pc.pdf", width=8, height=3, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsVarsConPermimp1pc.pdf")
}
Selected metric
absVar <- "UASLAEMaxLR"
iVars <- c(absVar, eventVar, ambVar, "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonLdECMAPowAvgBin", "UASTonLdECMA05ExBin", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR",
"UASTonShpAurSHMPowAvgBin", "UASTonShpAurSHM05ExBin")
dVar <- "dAnnoyMean"
seeds <- c(540, 104798, 456464, 87331, 94564)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/1.5)
Train preliminary model
# Tonality with tonal loudness
nperm <- 5
resultsOutTonal1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 0.6817226
resultsOutTonal1$OOB_MAE
[1] 0.5354283
resultsOutTonal1$Rsquared
[1] 0.8328264
Train multiple seeds model
# Tonality with tonal loudness
resultsOutTonal1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 0.6726346
resultsOutTonal1$OOB_MAE
[1] 0.5320356
resultsOutTonal1$Rsquared
[1] 0.8402319
# store results
resdAnnoyMnFitAB['Abs tonal inc loud', 'RMSE'] <- resultsOutTonal1$OOB_RMSE
resdAnnoyMnFitAB['Abs tonal inc loud', 'MAE'] <- resultsOutTonal1$OOB_MAE
resdAnnoyMnFitAB['Abs tonal inc loud', 'Rsquared'] <- resultsOutTonal1$Rsquared
resdAnnoyMnPermImpAB$AbsTonal1 <- resultsOutTonal1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal1.conimp <- arrange(resultsOutTonal1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal1.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal1.conimp), levels=rownames(resultsOutTonal1.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("Tonality inc. tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1.4))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnTonalLdConPermimp.svg", width=8, height=5, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnTonalLdConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnTonalLdConPermimp.pdf", width=8, height=5, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnTonalLdConPermimp.pdf")
}
Selected metric
tonLdVar <- "UASTonLdECMAPowAvgBin"
iVars <- c(absVar, eventVar, ambVar, "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR")
dVar <- "dAnnoyMean"
seeds <- c(156089, 5860, 10528, 89541, 4685146)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
# Tonality
nperm <- 5
resultsOutTonal2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 0.6735604
resultsOutTonal2$OOB_MAE
[1] 0.5215824
resultsOutTonal2$Rsquared
[1] 0.835001
Train multiple seeds model
# Tonality
resultsOutTonal2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 0.6770415
resultsOutTonal2$OOB_MAE
[1] 0.526503
resultsOutTonal2$Rsquared
[1] 0.8322548
# store results
resdAnnoyMnFitAB['Abs tonal no loud', 'RMSE'] <- resultsOutTonal2$OOB_RMSE
resdAnnoyMnFitAB['Abs tonal no loud', 'MAE'] <- resultsOutTonal2$OOB_MAE
resdAnnoyMnFitAB['Abs tonal no loud', 'Rsquared'] <- resultsOutTonal2$Rsquared
resdAnnoyMnPermImpAB$AbsTonal2 <- resultsOutTonal2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal2.conimp <- arrange(resultsOutTonal2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal2.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal2.conimp), levels=rownames(resultsOutTonal2.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("Tonality w/o tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1.4))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnTonalConPermimp.svg", width=8, height=4.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnTonalConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnTonalConPermimp.pdf", width=8, height=4.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnTonalConPermimp.pdf")
}
Selected metric
tonalVar <- "UASTonalAwSHMInt05ExMaxLR"
# Fluctuation strength
iVars <- c(absVar, eventVar, ambVar, "UASFluctOldSHM10ExBin", "UASFluctOldSHM05ExBin", "UASFluctECMA10ExBin", "UASFluctECMA05ExBin", "UASFluctFZ10ExMaxLR", "UASFluctFZ05ExMaxLR", "UASFluctOV10ExMaxLR", "UASFluctOV05ExMaxLR")
dVar <- "dAnnoyMean"
seeds <- c(25107, 546098, 195, 5937, 102658)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 5501
mtry <- as.integer(length(iVars)/1.5)
Train preliminary model
nperm <- 5
resultsOutFluct <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 0.6411068
resultsOutFluct$OOB_MAE
[1] 0.5139778
resultsOutFluct$Rsquared
[1] 0.8590107
Train multiple seeds model
resultsOutFluct <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 0.6442208
resultsOutFluct$OOB_MAE
[1] 0.5160342
resultsOutFluct$Rsquared
[1] 0.8570714
# store results
resdAnnoyMnFitAB['Abs fluct', 'RMSE'] <- resultsOutFluct$OOB_RMSE
resdAnnoyMnFitAB['Abs fluct', 'MAE'] <- resultsOutFluct$OOB_MAE
resdAnnoyMnFitAB['Abs fluct', 'Rsquared'] <- resultsOutFluct$Rsquared
resdAnnoyMnPermImpAB$AbsFluct <- resultsOutFluct$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutFluct.conimp <- arrange(resultsOutFluct$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutFluct.conimp) + geom_col(aes(x=factor(rownames(resultsOutFluct.conimp), levels=rownames(resultsOutFluct.conimp)), y=CondPermImp), fill=mycolours[4], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("Fluctuation strength") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnFluctConPermimp.svg", width=8, height=3.5, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnFluctConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnFluctConPermimp.pdf", width=8, height=3.5, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnFluctConPermimp.pdf")
}
Selected metric
fluctVar <- "UASFluctECMA10ExBin"
# Roughness
iVars <- c(absVar, eventVar, ambVar, "UASRoughECMA10ExBin", "UASRoughECMA05ExBin", "UASRoughFZ10ExMaxLR", "UASRoughFZ05ExMaxLR", "UASRoughDW10ExMaxLR", "UASRoughDW05ExMaxLR")
dVar <- "dAnnoyMean"
seeds <- c(4701, 52187, 16589, 65217, 16893)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1001
mtry <- as.integer(length(iVars)/1.8)
Train preliminary model
nperm <- 5
resultsOutRough <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 0.6741884
resultsOutRough$OOB_MAE
[1] 0.5361558
resultsOutRough$Rsquared
[1] 0.8539761
Train multiple seeds model
resultsOutRough <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 0.6614793
resultsOutRough$OOB_MAE
[1] 0.5271245
resultsOutRough$Rsquared
[1] 0.8617422
# store results
resdAnnoyMnFitAB['Abs rough', 'RMSE'] <- resultsOutRough$OOB_RMSE
resdAnnoyMnFitAB['Abs rough', 'MAE'] <- resultsOutRough$OOB_MAE
resdAnnoyMnFitAB['Abs rough', 'Rsquared'] <- resultsOutRough$Rsquared
resdAnnoyMnPermImpAB$AbsRough <- resultsOutRough$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutRough.conimp <- arrange(resultsOutRough$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutRough.conimp) + geom_col(aes(x=factor(rownames(resultsOutRough.conimp), levels=rownames(resultsOutRough.conimp)), y=CondPermImp), fill=mycolours[5], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("Roughness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnRoughConPermimp.svg", width=8, height=2.9, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnRoughConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnRoughConPermimp.pdf", width=8, height=2.9, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnRoughConPermimp.pdf")
}
Selected metric
roughVar <- "UASRoughFZ05ExMaxLR"
# Impulsiveness
iVars <- c(absVar, eventVar, ambVar, "UASImpulsSHMAvgMaxLR", "UASImpulsSHM05ExMaxLR", "UASImpulsSHMPowAvgMaxLR", "UASImpulsLoudWZAvgMaxLR", "UASImpulsLoudWZ05ExMaxLR", "UASImpulsLoudWZPowAvgMaxLR", "UASImpulsLoudWECMAAvgBin", "UASImpulsLoudWECMA05ExBin", "UASImpulsLoudWECMAPowAvgBin")
dVar <- "dAnnoyMean"
seeds <- c(8495, 59867, 5416, 9843, 86)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutImpuls <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 0.6721437
resultsOutImpuls$OOB_MAE
[1] 0.5263928
resultsOutImpuls$Rsquared
[1] 0.8394367
Train multiple seeds model
resultsOutImpuls <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 0.671666
resultsOutImpuls$OOB_MAE
[1] 0.525632
resultsOutImpuls$Rsquared
[1] 0.8396473
# store results
resdAnnoyMnFitAB['Abs impuls', 'RMSE'] <- resultsOutImpuls$OOB_RMSE
resdAnnoyMnFitAB['Abs impuls', 'MAE'] <- resultsOutImpuls$OOB_MAE
resdAnnoyMnFitAB['Abs impuls', 'Rsquared'] <- resultsOutImpuls$Rsquared
resdAnnoyMnPermImpAB$AbsImpuls <- resultsOutImpuls$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutImpuls.conimp <- arrange(resultsOutImpuls$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutImpuls.conimp) + geom_col(aes(x=factor(rownames(resultsOutImpuls.conimp), levels=rownames(resultsOutImpuls.conimp)), y=CondPermImp), fill=mycolours[6], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("Impulsiveness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnImpulsConPermimp.svg", width=8, height=3.8, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnImpulsConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnImpulsConPermimp.pdf", width=8, height=3.8, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnImpulsConPermimp.pdf")
}
Selected metric
impulsVar <- "UASImpulsLoudWZAvgMaxLR"
Now the highest importance SQMs are ranked against each other, controlling for UAS loudness and ambient LAeq.
iVars <- c(absVar, eventVar, ambVar, sharpVar, tonLdVar, fluctVar, roughVar, impulsVar)
dVar <- "dAnnoyMean"
seeds <- c(70498, 4, 14986, 453, 864)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 2501
mtry <- as.integer(length(iVars)/1.6)
Train preliminary model
nperm <- 5
resultsOutSQMs1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 0.6690392
resultsOutSQMs1$OOB_MAE
[1] 0.5373742
resultsOutSQMs1$Rsquared
[1] 0.8465967
Train multiple seeds model
resultsOutSQMs1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 0.6651781
resultsOutSQMs1$OOB_MAE
[1] 0.5349845
resultsOutSQMs1$Rsquared
[1] 0.8487605
# store results
resdAnnoyMnFitAB['Abs SQMs inc tonal loud', 'RMSE'] <- resultsOutSQMs1$OOB_RMSE
resdAnnoyMnFitAB['Abs SQMs inc tonal loud', 'MAE'] <- resultsOutSQMs1$OOB_MAE
resdAnnoyMnFitAB['Abs SQMs inc tonal loud', 'Rsquared'] <- resultsOutSQMs1$Rsquared
resdAnnoyMnPermImpAB$AbsSQMs1 <- resultsOutSQMs1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs1.conimp <- arrange(resultsOutSQMs1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs1.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs1.conimp), levels=rownames(resultsOutSQMs1.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1.3))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsSQMsTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsSQMsTonLdConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAbsSQMsTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsSQMsTonLdConPermimp.pdf")
}
iVars <- c(absVar, eventVar, ambVar, sharpVar, tonalVar, fluctVar, roughVar, impulsVar)
dVar <- "dAnnoyMean"
seeds <- c(546, 57203, 270835, 60592, 8094)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1501
mtry <- as.integer(length(iVars)/1.6)
Train preliminary model
nperm <- 5
resultsOutSQMs2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 0.6741422
resultsOutSQMs2$OOB_MAE
[1] 0.5413668
resultsOutSQMs2$Rsquared
[1] 0.8439303
Train multiple seeds model
resultsOutSQMs2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 0.6606138
resultsOutSQMs2$OOB_MAE
[1] 0.5318176
resultsOutSQMs2$Rsquared
[1] 0.8522687
# store results
resdAnnoyMnFitAB['Abs SQMs no tonal loud', 'RMSE'] <- resultsOutSQMs2$OOB_RMSE
resdAnnoyMnFitAB['Abs SQMs no tonal loud', 'MAE'] <- resultsOutSQMs2$OOB_MAE
resdAnnoyMnFitAB['Abs SQMs no tonal loud', 'Rsquared'] <- resultsOutSQMs2$Rsquared
resdAnnoyMnPermImpAB$AbsSQMs2 <- resultsOutSQMs2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs2.conimp <- arrange(resultsOutSQMs2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs2.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs2.conimp), levels=rownames(resultsOutSQMs2.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1.3))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsSQMsNoTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsSQMsNoTonLdConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAbsSQMsNoTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsSQMsNoTonLdConPermimp.pdf")
}
iVars <- c(ambVar, "UASPsychAnnoyWidmann", "UASPsychAnnoyMore", "UASPsychAnnoyDi", "UASPsychAnnoyTorija", "UASPsychAnnoyWillemsen", "UASPsychAnnoyBoucher")
dVar <- "dAnnoyMean"
seeds <- c(829, 9, 190, 4564, 924707824)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1501
mtry <- as.integer(length(iVars)/1.75)
Train preliminary model
nperm <- 5
resultsOutPA <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 0.6959625
resultsOutPA$OOB_MAE
[1] 0.5694917
resultsOutPA$Rsquared
[1] 0.8202226
Train multiple seeds model
resultsOutPA <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 0.6987601
resultsOutPA$OOB_MAE
[1] 0.5691674
resultsOutPA$Rsquared
[1] 0.8188134
# store results
resdAnnoyMnFitAB['Psychoacoustic annoyance', 'RMSE'] <- resultsOutPA$OOB_RMSE
resdAnnoyMnFitAB['Psychoacoustic annoyance', 'MAE'] <- resultsOutPA$OOB_MAE
resdAnnoyMnFitAB['Psychoacoustic annoyance', 'Rsquared'] <- resultsOutPA$Rsquared
resdAnnoyMnPermImpAB$AbsPA <- resultsOutPA$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutPA.conimp <- arrange(resultsOutPA$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutPA.conimp) + geom_col(aes(x=factor(rownames(resultsOutPA.conimp), levels=rownames(resultsOutPA.conimp)), y=CondPermImp), fill=mycolours[10], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1.8))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAbsPAConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAbsPAConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAbsPAConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAbsPAConPermimp.pdf")
}
iVars <- names(stimDataNum)[which(names(stimDataNum) == 'UASEvents'):which(names(stimDataNum) == 'dPsychAnnoyBoucher')]
dVar <- "dAnnoyMean"
seeds <- c(14569, 98651, 54654498, 454948, 41321)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllVarsHyperTune.svg", width=12, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllVarsHyperTune.svg")
ggsave(filename="PtsABdAnnoyMnAllVarsHyperTune.pdf", width=12, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllVarsHyperTune.pdf")
}
Selected hyperparameters
ntree <- 2501
mtry <- as.integer(length(iVars)/3.5)
Train preliminary model
nperm <- 5
resultsOutAbsDiffs <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbsDiffs$OOB_RMSE
[1] 0.5232516
resultsOutAbsDiffs$OOB_MAE
[1] 0.4044405
resultsOutAbsDiffs$Rsquared
[1] 0.8933325
Train multiple seeds model
resultsOutAbsDiffs <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbsDiffs$OOB_RMSE
[1] 0.5251036
resultsOutAbsDiffs$OOB_MAE
[1] 0.4057256
resultsOutAbsDiffs$Rsquared
[1] 0.8925424
# store results
resdAnnoyMnFitAB['All vars', 'RMSE'] <- resultsOutAbsDiffs$OOB_RMSE
resdAnnoyMnFitAB['All vars', 'MAE'] <- resultsOutAbsDiffs$OOB_MAE
resdAnnoyMnFitAB['All vars', 'Rsquared'] <- resultsOutAbsDiffs$Rsquared
resdAnnoyMnPermImpAB$AllVars <- resultsOutAbsDiffs$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutAbsDiffs.conimp <- arrange(resultsOutAbsDiffs$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutAbsDiffs.conimp) + geom_col(aes(x=factor(rownames(resultsOutAbsDiffs.conimp), levels=rownames(resultsOutAbsDiffs.conimp)), y=CondPermImp), fill=mycolours[9], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllVarsConPermimp.svg", width=8, height=30, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllVarsConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllVarsConPermimp.pdf", width=8, height=30, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllVarsConPermimp.pdf")
}
# Plot only positive values
resultsOutAbsDiffs.conimpPtv <- resultsOutAbsDiffs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > 0)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbsDiffs.conimpPtv) + geom_col(aes(x=factor(rownames(resultsOutAbsDiffs.conimpPtv), levels=rownames(resultsOutAbsDiffs.conimpPtv)), y=CondPermImp), fill=mycolours[9], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllVarsConPermimpPtv.svg", width=8, height=18, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllVarsConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllVarsConPermimpPtv.pdf", width=8, height=18, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllVarsConPermimp.pdf")
}
# Plot only values within 1% of the maximum
resultsOutAbsDiffs.conimp1pc <- resultsOutAbsDiffs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > max(resultsOutAbsDiffs.conimp)/100)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbsDiffs.conimp1pc) + geom_col(aes(x=factor(rownames(resultsOutAbsDiffs.conimp1pc), levels=rownames(resultsOutAbsDiffs.conimp1pc)), y=CondPermImp), fill=mycolours[9], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllVarsConPermimp1pc.svg", width=8, height=6, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllVarsConPermimp1pc.svg")
ggsave(filename="PtsABdAnnoyMnAllVarsConPermimp1pc.pdf", width=8, height=6, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllVarsConPermimp1pc.pdf")
}
Selected metric
allVar <- "Detect0p1dBIntMaxLR"
iVars <- c(allVar, eventVar, ambVar, "dSharpAurISO3PowAvgBin", "dSharpAurISO305ExBin", "dSharpAurSHMPowAvgBin", "dSharpAurSHM05ExBin", "dTonShpAurSHMPowAvgBin", "dTonShpAurSHM05ExBin", "PartTonShpAurSHMPowAvgBin",
"PartTonShpAurSHM05ExBin", "UASSharpAurISO3PowAvgBin", "UASSharpAurISO305ExBin", "UASSharpAurSHMPowAvgBin", "UASSharpAurSHM05ExBin", "UASSharpAurISO1PowAvgBin", "UASSharpAurISO105ExBin", "UASSharpvBISO1PowAvgBin", "UASSharpvBISO105ExBin", "UASSharpDINPowAvgBin", "UASSharpDIN05ExBin", "UASSharpAurISO1MedBin",
"UASTonShpAurSHMPowAvgBin", "UASTonShpAurSHM05ExBin")
dVar <- "dAnnoyMean"
seeds <- c(84194, 905, 64815, 928054, 625091)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <-251
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutSharp <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSharp$OOB_RMSE
[1] 0.5170055
resultsOutSharp$OOB_MAE
[1] 0.3896635
resultsOutSharp$Rsquared
[1] 0.8955904
Train multiple seeds model
resultsOutSharp <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSharp$OOB_RMSE
[1] 0.5117732
resultsOutSharp$OOB_MAE
[1] 0.3910043
resultsOutSharp$Rsquared
[1] 0.8983711
# store results
resdAnnoyMnFitAB['All sharp', 'RMSE'] <- resultsOutSharp$OOB_RMSE
resdAnnoyMnFitAB['All sharp', 'MAE'] <- resultsOutSharp$OOB_MAE
resdAnnoyMnFitAB['All sharp', 'Rsquared'] <- resultsOutSharp$Rsquared
resdAnnoyMnPermImpAB$AllSharp <- resultsOutSharp$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSharp.conimp <- arrange(resultsOutSharp$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSharp.conimp) + geom_col(aes(x=factor(rownames(resultsOutSharp.conimp), levels=rownames(resultsOutSharp.conimp)), y=CondPermImp), fill=mycolours[2], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("All sharpness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllSharpConPermimp.svg", width=8, height=5.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllSharpConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllSharpConPermimp.pdf", width=8, height=5.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllSharpConPermimp.pdf")
}
Selected metric
allSharpVar <- "dSharpAurISO3PowAvgBin"
iVars <- c(allVar, eventVar, ambVar, "dTonalECMAAvgMaxLR", "dTonalSHMInt05ExMaxLR", "dTonalSHMIntAvgMaxLR", "dTonalECMA05ExMaxLR", "dTonalAwSHMAvgMaxLR", "dTonalAwSHM05ExMaxLR", "dTonalAwSHMIntAvgMaxLR", "dTonalAwSHMInt05ExMaxLR", "dTonLdECMAPowAvgBin", "dTonLdECMA05ExBin", "dTonShpAurSHMPowAvgBin",
"dTonShpAurSHM05ExBin", "PartTonLdSHMPowAvgBin", "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonLdECMAPowAvgBin", "UASTonLdECMA05ExBin", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR",
"UASTonShpAurSHMPowAvgBin", "UASTonShpAurSHM05ExBin")
dVar <- "dAnnoyMean"
seeds <- c(561684, 104798, 1536, 48, 48561)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
# Tonality with tonal loudness
nperm <- 5
resultsOutTonal1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 0.5151597
resultsOutTonal1$OOB_MAE
[1] 0.4039491
resultsOutTonal1$Rsquared
[1] 0.8960478
Train multiple seeds model
# Tonality with tonal loudness
resultsOutTonal1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 0.5103953
resultsOutTonal1$OOB_MAE
[1] 0.4021889
resultsOutTonal1$Rsquared
[1] 0.8981797
# store results
resdAnnoyMnFitAB['All tonal inc loud', 'RMSE'] <- resultsOutTonal1$OOB_RMSE
resdAnnoyMnFitAB['All tonal inc loud', 'MAE'] <- resultsOutTonal1$OOB_MAE
resdAnnoyMnFitAB['All tonal inc loud', 'Rsquared'] <- resultsOutTonal1$Rsquared
resdAnnoyMnPermImpAB$AllTonal1 <- resultsOutTonal1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal1.conimp <- arrange(resultsOutTonal1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal1.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal1.conimp), levels=rownames(resultsOutTonal1.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("All tonality inc. tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 2.2))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllTonalLdConPermimp.svg", width=8, height=6, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllTonalLdConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllTonalLdConPermimp.pdf", width=8, height=6, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllTonalLdConPermimp.pdf")
}
Selected metric
allTonLdVar <- "dTonLdECMAPowAvgBin"
iVars <- c(allVar, eventVar, ambVar, "dTonalECMAAvgMaxLR", "dTonalSHMInt05ExMaxLR", "dTonalSHMIntAvgMaxLR", "dTonalECMA05ExMaxLR", "dTonalAwSHMAvgMaxLR", "dTonalAwSHM05ExMaxLR", "dTonalAwSHMIntAvgMaxLR", "dTonalAwSHMInt05ExMaxLR", "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR")
dVar <- "dAnnoyMean"
seeds <- c(410865, 2954, 70812, 203, 7984)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
# Tonality
nperm <- 5
resultsOutTonal2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 0.5010944
resultsOutTonal2$OOB_MAE
[1] 0.3841466
resultsOutTonal2$Rsquared
[1] 0.9029128
Train multiple seeds model
# Tonality
resultsOutTonal2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 0.5000554
resultsOutTonal2$OOB_MAE
[1] 0.3831858
resultsOutTonal2$Rsquared
[1] 0.9033995
# store results
resdAnnoyMnFitAB['All tonal no loud', 'RMSE'] <- resultsOutTonal2$OOB_RMSE
resdAnnoyMnFitAB['All tonal no loud', 'MAE'] <- resultsOutTonal2$OOB_MAE
resdAnnoyMnFitAB['All tonal no loud', 'Rsquared'] <- resultsOutTonal2$Rsquared
resdAnnoyMnPermImpAB$AllTonal2 <- resultsOutTonal2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal2.conimp <- arrange(resultsOutTonal2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal2.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal2.conimp), levels=rownames(resultsOutTonal2.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("All tonality w/o tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 2.6))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllTonalConPermimp.svg", width=8, height=5.8, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllTonalConPermimp.svg")
ggsave(filename="PtsABAllAnnoyMndTonalConPermimp.pdf", width=8, height=5.8, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllTonalConPermimp.pdf")
}
Selected metric
allTonalVar <- "dTonalSHMIntAvgMaxLR"
# Fluctuation strength
iVars <- c(allVar, eventVar, ambVar, "dFluctECMA10ExBin", "dFluctECMA05ExBin", "dFluctOV10ExMaxLR", "dFluctOV05ExMaxLR", "UASFluctOldSHM10ExBin", "UASFluctOldSHM05ExBin", "UASFluctECMA10ExBin", "UASFluctECMA05ExBin", "UASFluctFZ10ExMaxLR", "UASFluctFZ05ExMaxLR", "UASFluctOV10ExMaxLR", "UASFluctOV05ExMaxLR")
dVar <- "dAnnoyMean"
seeds <- c(418657, 84, 1630, 18659, 3687)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- as.integer(length(iVars)/1.5)
Train preliminary model
nperm <- 5
resultsOutFluct <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 0.4966309
resultsOutFluct$OOB_MAE
[1] 0.3732706
resultsOutFluct$Rsquared
[1] 0.9046225
Train multiple seeds model
resultsOutFluct <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 0.4969742
resultsOutFluct$OOB_MAE
[1] 0.3744435
resultsOutFluct$Rsquared
[1] 0.9047033
# store results
resdAnnoyMnFitAB['All fluct', 'RMSE'] <- resultsOutFluct$OOB_RMSE
resdAnnoyMnFitAB['All fluct', 'MAE'] <- resultsOutFluct$OOB_MAE
resdAnnoyMnFitAB['All fluct', 'Rsquared'] <- resultsOutFluct$Rsquared
resdAnnoyMnPermImpAB$AllFluct <- resultsOutFluct$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutFluct.conimp <- arrange(resultsOutFluct$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutFluct.conimp) + geom_col(aes(x=factor(rownames(resultsOutFluct.conimp), levels=rownames(resultsOutFluct.conimp)), y=CondPermImp), fill=mycolours[4], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("All fluctuation strength") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllFluctConPermimp.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllFluctConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllFluctConPermimp.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllFluctConPermimp.pdf")
}
Selected metric
allFluctVar <- "dFluctECMA10ExBin"
# Roughness
iVars <- c(allVar, eventVar, ambVar, "dRoughECMA10ExBin", "dRoughECMA05ExBin", "dRoughFZ10ExMaxLR", "dRoughFZ05ExMaxLR", "UASRoughECMA10ExBin", "UASRoughECMA05ExBin", "UASRoughFZ10ExMaxLR", "UASRoughFZ05ExMaxLR", "UASRoughDW10ExMaxLR", "UASRoughDW05ExMaxLR")
dVar <- "dAnnoyMean"
seeds <- c(69851, 85109, 410986, 1563, 896)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1001
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutRough <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 0.5060503
resultsOutRough$OOB_MAE
[1] 0.3812809
resultsOutRough$Rsquared
[1] 0.9036606
Train multiple seeds model
resultsOutRough <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 0.5099848
resultsOutRough$OOB_MAE
[1] 0.3855287
resultsOutRough$Rsquared
[1] 0.9015348
# store results
resdAnnoyMnFitAB['All rough', 'RMSE'] <- resultsOutRough$OOB_RMSE
resdAnnoyMnFitAB['All rough', 'MAE'] <- resultsOutRough$OOB_MAE
resdAnnoyMnFitAB['All rough', 'Rsquared'] <- resultsOutRough$Rsquared
resdAnnoyMnPermImpAB$AllRough <- resultsOutRough$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutRough.conimp <- arrange(resultsOutRough$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutRough.conimp) + geom_col(aes(x=factor(rownames(resultsOutRough.conimp), levels=rownames(resultsOutRough.conimp)), y=CondPermImp), fill=mycolours[5], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("All roughness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllRoughConPermimp.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllRoughConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllRoughConPermimp.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllRoughConPermimp.pdf")
}
Selected metric
allRoughVar <- "dRoughFZ05ExMaxLR"
# Impulsiveness
iVars <- c(allVar, eventVar, ambVar, "dImpulsSHMAvgMaxLR", "dImpulsSHM05ExMaxLR", "dImpulsSHMPowAvgMaxLR",
"dImpulsLoudWZAvgMaxLR", "dImpulsLoudWZ05ExMaxLR", "dImpulsLoudWZPowAvgMaxLR",
"dImpulsLoudWECMAAvgBin", "dImpulsLoudWECMA05ExBin", "dImpulsLoudWECMAPowAvgBin", "UASImpulsSHMAvgMaxLR", "UASImpulsSHM05ExMaxLR", "UASImpulsSHMPowAvgMaxLR", "UASImpulsLoudWZAvgMaxLR", "UASImpulsLoudWZ05ExMaxLR", "UASImpulsLoudWZPowAvgMaxLR", "UASImpulsLoudWECMAAvgBin", "UASImpulsLoudWECMA05ExBin", "UASImpulsLoudWECMAPowAvgBin")
dVar <- "dAnnoyMean"
seeds <- c(418659, 7805, 38475, 65834, 1653)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutImpuls <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 0.5081669
resultsOutImpuls$OOB_MAE
[1] 0.3888782
resultsOutImpuls$Rsquared
[1] 0.9001747
Train multiple seeds model
resultsOutImpuls <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 0.5077729
resultsOutImpuls$OOB_MAE
[1] 0.3904791
resultsOutImpuls$Rsquared
[1] 0.9006062
# store results
resdAnnoyMnFitAB['All impuls', 'RMSE'] <- resultsOutImpuls$OOB_RMSE
resdAnnoyMnFitAB['All impuls', 'MAE'] <- resultsOutImpuls$OOB_MAE
resdAnnoyMnFitAB['All impuls', 'Rsquared'] <- resultsOutImpuls$Rsquared
resdAnnoyMnPermImpAB$AllImpuls <- resultsOutImpuls$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutImpuls.conimp <- arrange(resultsOutImpuls$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutImpuls.conimp) + geom_col(aes(x=factor(rownames(resultsOutImpuls.conimp), levels=rownames(resultsOutImpuls.conimp)), y=CondPermImp), fill=mycolours[6], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + ggtitle("All impulsiveness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllImpulsConPermimp.svg", width=8, height=5.6, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllImpulsConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllImpulsConPermimp.pdf", width=8, height=5.6, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllImpulsConPermimp.pdf")
}
Selected metric
allImpulsVar <- "dImpulsLoudWZAvgMaxLR"
Now the highest importance dSQMs are ranked against each other, controlling for loudness difference.
iVars <- c(allVar, eventVar, ambVar, allSharpVar, allTonLdVar, allFluctVar, allRoughVar, allImpulsVar)
dVar <- "dAnnoyMean"
seeds <- c(98465, 54163, 6541, 36485, 849675)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/2)
Train preliminary model
nperm <- 5
resultsOutSQMs1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 0.4971808
resultsOutSQMs1$OOB_MAE
[1] 0.3860652
resultsOutSQMs1$Rsquared
[1] 0.9059535
Train multiple seeds model
resultsOutSQMs1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 0.4991241
resultsOutSQMs1$OOB_MAE
[1] 0.3861392
resultsOutSQMs1$Rsquared
[1] 0.904781
# store results
resdAnnoyMnFitAB['All SQMs inc tonal loud', 'RMSE'] <- resultsOutSQMs1$OOB_RMSE
resdAnnoyMnFitAB['All SQMs inc tonal loud', 'MAE'] <- resultsOutSQMs1$OOB_MAE
resdAnnoyMnFitAB['All SQMs inc tonal loud', 'Rsquared'] <- resultsOutSQMs1$Rsquared
resdAnnoyMnPermImpAB$AllSQMs1 <- resultsOutSQMs1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs1.conimp <- arrange(resultsOutSQMs1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs1.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs1.conimp), levels=rownames(resultsOutSQMs1.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 2))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllSQMsTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllSQMsTonLdConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllSQMsTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllSQMsTonLdConPermimp.pdf")
}
iVars <- c(allVar, eventVar, ambVar, allSharpVar, allTonalVar, allFluctVar, allRoughVar, allImpulsVar)
dVar <- "dAnnoyMean"
seeds <- c(49865, 7852, 845961, 410583, 36748)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 2501
mtry <- as.integer(length(iVars)/1.6)
Train preliminary model
nperm <- 5
resultsOutSQMs2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 0.4906752
resultsOutSQMs2$OOB_MAE
[1] 0.3786122
resultsOutSQMs2$Rsquared
[1] 0.9089686
Train multiple seeds model
resultsOutSQMs2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 0.4897326
resultsOutSQMs2$OOB_MAE
[1] 0.376146
resultsOutSQMs2$Rsquared
[1] 0.9091913
# store results
resdAnnoyMnFitAB['All SQMs no tonal loud', 'RMSE'] <- resultsOutSQMs2$OOB_RMSE
resdAnnoyMnFitAB['All SQMs no tonal loud', 'MAE'] <- resultsOutSQMs2$OOB_MAE
resdAnnoyMnFitAB['All SQMs no tonal loud', 'Rsquared'] <- resultsOutSQMs2$Rsquared
resdAnnoyMnPermImpAB$AllSQMs2 <- resultsOutSQMs2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs2.conimp <- arrange(resultsOutSQMs2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs2.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs2.conimp), levels=rownames(resultsOutSQMs2.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 2))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllSQMsNoTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllSQMsNoTonLdConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllSQMsNoTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllSQMsNoTonLdConPermimp.pdf")
}
iVars <- c(ambVar, "dPsychAnnoyWidmann", "dPsychAnnoyMore", "dPsychAnnoyDi", "dPsychAnnoyTorija", "dPsychAnnoyWillemsen", "dPsychAnnoyBoucher", "UASPsychAnnoyWidmann", "UASPsychAnnoyMore", "UASPsychAnnoyDi", "UASPsychAnnoyTorija", "UASPsychAnnoyWillemsen", "UASPsychAnnoyBoucher")
dVar <- "dAnnoyMean"
seeds <- c(47896643, 475, 654, 98987132, 5446)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutPA <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 0.7066857
resultsOutPA$OOB_MAE
[1] 0.5544466
resultsOutPA$Rsquared
[1] 0.8031693
Train multiple seeds model
resultsOutPA <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 0.7071518
resultsOutPA$OOB_MAE
[1] 0.5548064
resultsOutPA$Rsquared
[1] 0.8028069
# store results
resdAnnoyMnFitAB['All Psychoacoustic annoyance', 'RMSE'] <- resultsOutPA$OOB_RMSE
resdAnnoyMnFitAB['All Psychoacoustic annoyance', 'MAE'] <- resultsOutPA$OOB_MAE
resdAnnoyMnFitAB['All Psychoacoustic annoyance', 'Rsquared'] <- resultsOutPA$Rsquared
resdAnnoyMnPermImpAB$AllPA <- resultsOutPA$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutPA.conimp <- arrange(resultsOutPA$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutPA.conimp) + geom_col(aes(x=factor(rownames(resultsOutPA.conimp), levels=rownames(resultsOutPA.conimp)), y=CondPermImp), fill=mycolours[10], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (mean change in annoyance)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1.8))
pBar
if (saveplots){
ggsave(filename="PtsABdAnnoyMnAllPAConPermimp.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdAnnoyMnAllPAConPermimp.svg")
ggsave(filename="PtsABdAnnoyMnAllPAConPermimp.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdAnnoyMnAllPAConPermimp.pdf")
}
if (savedata){
utils::write.csv(resdAnnoyMnFitAB, paste(outDataPath, "\\PtsABCRFdAnnoyMnOOBFit.csv", sep=""))
ii <- 0
temp = list()
for (res in resdAnnoyMnPermImpAB){
ii <- ii + 1
temp[[ii]] <- as.data.frame(resdAnnoyMnPermImpAB[ii])
names(temp[[ii]]) <- names(resdAnnoyMnPermImpAB[ii])
}
openxlsx::write.xlsx(temp, paste(outDataPath, "\\PtsABCRFdAnnoyMnConPermimp.xlsx",
sep=""),
rowNames=TRUE)
}
resdHiAnnoyFitAB <- data.frame(RMSE = numeric(),
MAE = numeric(),
Rsquared = numeric())
resdHiAnnoyPermImpAB <- list()
iVars <- names(stimDataNum)[which(names(stimDataNum) == 'UASEvents'):which(names(stimDataNum) == 'UASPsychAnnoyBoucher')]
iVars <- iVars[! iVars %in% c('SNRlevel', 'IntermitRatioC2MaxLR', 'IntermitRatioC3MaxLR', 'IntermitRatioC5MaxLR')]
dVar <- "dHighAnnoyPc"
seeds <- c(578312, 544, 84894, 54654, 153157)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsVarsHyperTune.svg", width=12, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsVarsHyperTune.svg")
ggsave(filename="PtsABdHiAnnoyAbsVarsHyperTune.pdf", width=12, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsVarsHyperTune.pdf")
}
Selected hyperparameters
ntree <- 1501
mtry <- as.integer(length(iVars)/1.75)
Train preliminary model
nperm <- 5
resultsOutAbs <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbs$OOB_RMSE
[1] 6.203493
resultsOutAbs$OOB_MAE
[1] 4.787191
resultsOutAbs$Rsquared
[1] 0.6664964
Train multiple seeds model
resultsOutAbs <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbs$OOB_RMSE
[1] 6.205791
resultsOutAbs$OOB_MAE
[1] 4.775969
resultsOutAbs$Rsquared
[1] 0.6664051
# store results
resdHiAnnoyFitAB['Abs vars', 'RMSE'] <- resultsOutAbs$OOB_RMSE
resdHiAnnoyFitAB['Abs vars', 'MAE'] <- resultsOutAbs$OOB_MAE
resdHiAnnoyFitAB['Abs vars', 'Rsquared'] <- resultsOutAbs$Rsquared
resdHiAnnoyPermImpAB$AbsVars <- resultsOutAbs$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutAbs.conimp <- arrange(resultsOutAbs$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutAbs.conimp) + geom_col(aes(x=factor(rownames(resultsOutAbs.conimp), levels=rownames(resultsOutAbs.conimp)), y=CondPermImp), fill=mycolours[1], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) +
coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsVarsConPermimp.svg", width=8, height=14, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsVarsConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAbsVarsConPermimp.pdf", width=8, height=14, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsVarsConPermimp.pdf")
}
# Plot only positive values
resultsOutAbs.conimpPtv <- resultsOutAbs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > 0)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbs.conimpPtv,) + geom_col(aes(x=factor(rownames(resultsOutAbs.conimpPtv), levels=rownames(resultsOutAbs.conimpPtv)), y=CondPermImp), fill=mycolours[1], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsVarsConPermimpPtv.svg", width=8, height=10, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsVarsConPermimpPtv.svg")
ggsave(filename="PtsABdHiAnnoyAbsVarsConPermimpPtv.pdf", width=8, height=10, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsVarsConPermimpPtv.pdf")
}
# Plot only values within 1% of the maximum
resultsOutAbs.conimp1pc <- resultsOutAbs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > max(resultsOutAbs.conimp)/100)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbs.conimp1pc,) + geom_col(aes(x=factor(rownames(resultsOutAbs.conimp1pc), levels=rownames(resultsOutAbs.conimp1pc)), y=CondPermImp), fill=mycolours[1], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsVarsConPermimp1pc.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsVarsConPermimp1pc.svg")
ggsave(filename="PtsABdHiAnnoyAbsVarsConPermimp1pc.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsVarsConPermimp1pc.pdf")
}
Selected metric
absVar <- "UASLoudECMAPowAvgBin"
iVars <- c(absVar, eventVar, ambVar, "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonLdECMAPowAvgBin", "UASTonLdECMA05ExBin", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR",
"UASTonShpAurSHMPowAvgBin", "UASTonShpAurSHM05ExBin")
dVar <- "dHighAnnoyPc"
seeds <- c(540, 104798, 456464, 87331, 94564)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/1.5)
Train preliminary model
# Tonality with tonal loudness
nperm <- 5
resultsOutTonal1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 6.358715
resultsOutTonal1$OOB_MAE
[1] 4.808657
resultsOutTonal1$Rsquared
[1] 0.6484513
Train multiple seeds model
# Tonality with tonal loudness
resultsOutTonal1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 6.320428
resultsOutTonal1$OOB_MAE
[1] 4.782126
resultsOutTonal1$Rsquared
[1] 0.6527379
# store results
resdHiAnnoyFitAB['Abs tonal inc loud', 'RMSE'] <- resultsOutTonal1$OOB_RMSE
resdHiAnnoyFitAB['Abs tonal inc loud', 'MAE'] <- resultsOutTonal1$OOB_MAE
resdHiAnnoyFitAB['Abs tonal inc loud', 'Rsquared'] <- resultsOutTonal1$Rsquared
resdHiAnnoyPermImpAB$AbsTonal1 <- resultsOutTonal1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal1.conimp <- arrange(resultsOutTonal1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal1.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal1.conimp), levels=rownames(resultsOutTonal1.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("Tonality inc. tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 110))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyTonalLdConPermimp.svg", width=8, height=4.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyTonalLdConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyTonalLdConPermimp.pdf", width=8, height=4.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyTonalLdConPermimp.pdf")
}
Selected metric
tonLdVar <- "UASTonLdECMAPowAvgBin"
iVars <- c(absVar, eventVar, ambVar, "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR")
dVar <- "dHighAnnoyPc"
seeds <- c(156089, 5860, 10528, 89541, 4685146)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
# Tonality
nperm <- 5
resultsOutTonal2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm,
minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 6.434733
resultsOutTonal2$OOB_MAE
[1] 4.888113
resultsOutTonal2$Rsquared
[1] 0.640617
Train multiple seeds model
# Tonality
resultsOutTonal2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 6.454118
resultsOutTonal2$OOB_MAE
[1] 4.898967
resultsOutTonal2$Rsquared
[1] 0.6386236
# store results
resdHiAnnoyFitAB['Abs tonal no loud', 'RMSE'] <- resultsOutTonal2$OOB_RMSE
resdHiAnnoyFitAB['Abs tonal no loud', 'MAE'] <- resultsOutTonal2$OOB_MAE
resdHiAnnoyFitAB['Abs tonal no loud', 'Rsquared'] <- resultsOutTonal2$Rsquared
resdHiAnnoyPermImpAB$AbsTonal2 <- resultsOutTonal2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal2.conimp <- arrange(resultsOutTonal2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal2.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal2.conimp), levels=rownames(resultsOutTonal2.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("Tonality w/o tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 110))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyTonalConPermimp.svg", width=8, height=3.8, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyTonalConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyTonalConPermimp.pdf", width=8, height=3.8, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyTonalConPermimp.pdf")
}
Selected metric
tonalVar <- "UASTonalAwSHMInt05ExMaxLR"
# Fluctuation strength
iVars <- c(absVar, eventVar, ambVar, "UASFluctOldSHM10ExBin", "UASFluctOldSHM05ExBin", "UASFluctECMA10ExBin", "UASFluctECMA05ExBin", "UASFluctFZ10ExMaxLR", "UASFluctFZ05ExMaxLR", "UASFluctOV10ExMaxLR", "UASFluctOV05ExMaxLR")
dVar <- "dHighAnnoyPc"
seeds <- c(25107, 546098, 195, 5937, 102658)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutFluct <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres,
nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 6.468882
resultsOutFluct$OOB_MAE
[1] 4.835973
resultsOutFluct$Rsquared
[1] 0.636221
Train multiple seeds model
resultsOutFluct <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 6.48319
resultsOutFluct$OOB_MAE
[1] 4.846364
resultsOutFluct$Rsquared
[1] 0.6345453
# store results
resdHiAnnoyFitAB['Abs fluct', 'RMSE'] <- resultsOutFluct$OOB_RMSE
resdHiAnnoyFitAB['Abs fluct', 'MAE'] <- resultsOutFluct$OOB_MAE
resdHiAnnoyFitAB['Abs fluct', 'Rsquared'] <- resultsOutFluct$Rsquared
resdHiAnnoyPermImpAB$AbsFluct <- resultsOutFluct$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutFluct.conimp <- arrange(resultsOutFluct$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutFluct.conimp) + geom_col(aes(x=factor(rownames(resultsOutFluct.conimp), levels=rownames(resultsOutFluct.conimp)), y=CondPermImp), fill=mycolours[4], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("Fluctuation strength") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyFluctConPermimp.svg", width=8, height=2.9, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyFluctConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyFluctConPermimp.pdf", width=8, height=2.9, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyFluctConPermimp.pdf")
}
Selected metric
fluctVar <- "UASFluctECMA10ExBin"
# Roughness
iVars <- c(absVar, eventVar, ambVar, "UASRoughECMA10ExBin", "UASRoughECMA05ExBin", "UASRoughFZ10ExMaxLR", "UASRoughFZ05ExMaxLR", "UASRoughDW10ExMaxLR", "UASRoughDW05ExMaxLR")
dVar <- "dHighAnnoyPc"
seeds <- c(4701, 52187, 16589, 65217, 16893)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- as.integer(length(iVars)/1.5)
Train preliminary model
nperm <- 5
resultsOutRough <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 6.370114
resultsOutRough$OOB_MAE
[1] 4.823308
resultsOutRough$Rsquared
[1] 0.6515551
Train multiple seeds model
resultsOutRough <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 6.398763
resultsOutRough$OOB_MAE
[1] 4.841106
resultsOutRough$Rsquared
[1] 0.6481992
# store results
resdHiAnnoyFitAB['Abs rough', 'RMSE'] <- resultsOutRough$OOB_RMSE
resdHiAnnoyFitAB['Abs rough', 'MAE'] <- resultsOutRough$OOB_MAE
resdHiAnnoyFitAB['Abs rough', 'Rsquared'] <- resultsOutRough$Rsquared
resdHiAnnoyPermImpAB$AbsRough <- resultsOutRough$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutRough.conimp <- arrange(resultsOutRough$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutRough.conimp) + geom_col(aes(x=factor(rownames(resultsOutRough.conimp), levels=rownames(resultsOutRough.conimp)), y=CondPermImp), fill=mycolours[5], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("Roughness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyRoughConPermimp.svg", width=8, height=2.9, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyRoughConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyRoughConPermimp.pdf", width=8, height=2.9, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyRoughConPermimp.pdf")
}
Selected metric
roughVar <- "UASRoughFZ05ExMaxLR"
# Impulsiveness
iVars <- c(absVar, eventVar, ambVar, "UASImpulsSHMAvgMaxLR", "UASImpulsSHM05ExMaxLR", "UASImpulsSHMPowAvgMaxLR", "UASImpulsLoudWZAvgMaxLR", "UASImpulsLoudWZ05ExMaxLR", "UASImpulsLoudWZPowAvgMaxLR", "UASImpulsLoudWECMAAvgBin", "UASImpulsLoudWECMA05ExBin", "UASImpulsLoudWECMAPowAvgBin")
dVar <- "dHighAnnoyPc"
seeds <- c(8495, 59867, 5416, 9843, 86)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/1.5)
Train preliminary model
nperm <- 5
resultsOutImpuls <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 6.270202
resultsOutImpuls$OOB_MAE
[1] 4.842259
resultsOutImpuls$Rsquared
[1] 0.6582782
Train multiple seeds model
resultsOutImpuls <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 6.270233
resultsOutImpuls$OOB_MAE
[1] 4.84118
resultsOutImpuls$Rsquared
[1] 0.6582749
# store results
resdHiAnnoyFitAB['Abs impuls', 'RMSE'] <- resultsOutImpuls$OOB_RMSE
resdHiAnnoyFitAB['Abs impuls', 'MAE'] <- resultsOutImpuls$OOB_MAE
resdHiAnnoyFitAB['Abs impuls', 'Rsquared'] <- resultsOutImpuls$Rsquared
resdHiAnnoyPermImpAB$AbsImpuls <- resultsOutImpuls$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutImpuls.conimp <- arrange(resultsOutImpuls$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutImpuls.conimp) + geom_col(aes(x=factor(rownames(resultsOutImpuls.conimp), levels=rownames(resultsOutImpuls.conimp)), y=CondPermImp), fill=mycolours[6], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("Impulsiveness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyImpulsConPermimp.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyImpulsConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyImpulsConPermimp.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyImpulsConPermimp.pdf")
}
Selected metric
impulsVar <- "UASImpulsLoudWZAvgMaxLR"
Now the highest importance SQMs are ranked against each other, controlling for UAS loudness and ambient LAeq.
iVars <- c(absVar, eventVar, ambVar, sharpVar, tonLdVar, fluctVar, roughVar, impulsVar)
dVar <- "dHighAnnoyPc"
seeds <- c(70498, 4, 14986, 453, 864)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1501
mtry <- 3
Train preliminary model
nperm <- 5
resultsOutSQMs1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 6.112539
resultsOutSQMs1$OOB_MAE
[1] 4.697572
resultsOutSQMs1$Rsquared
[1] 0.6758278
Train multiple seeds model
resultsOutSQMs1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 6.115048
resultsOutSQMs1$OOB_MAE
[1] 4.695767
resultsOutSQMs1$Rsquared
[1] 0.6754898
# store results
resdHiAnnoyFitAB['Abs SQMs inc tonal loud', 'RMSE'] <- resultsOutSQMs1$OOB_RMSE
resdHiAnnoyFitAB['Abs SQMs inc tonal loud', 'MAE'] <- resultsOutSQMs1$OOB_MAE
resdHiAnnoyFitAB['Abs SQMs inc tonal loud', 'Rsquared'] <- resultsOutSQMs1$Rsquared
resdHiAnnoyPermImpAB$AbsSQMs1 <- resultsOutSQMs1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs1.conimp <- arrange(resultsOutSQMs1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs1.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs1.conimp), levels=rownames(resultsOutSQMs1.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 30))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsSQMsTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsSQMsTonLdConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAbsSQMsTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsSQMsTonLdConPermimp.pdf")
}
iVars <- c(absVar, eventVar, ambVar, sharpVar, tonalVar, fluctVar, roughVar, impulsVar)
dVar <- "dHighAnnoyPc"
seeds <- c(546, 57203, 270835, 60592, 8094)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- 3
Train preliminary model
nperm <- 5
resultsOutSQMs2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 6.081512
resultsOutSQMs2$OOB_MAE
[1] 4.686507
resultsOutSQMs2$Rsquared
[1] 0.6810178
Train multiple seeds model
resultsOutSQMs2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 6.101152
resultsOutSQMs2$OOB_MAE
[1] 4.702343
resultsOutSQMs2$Rsquared
[1] 0.6787822
# store results
resdHiAnnoyFitAB['Abs SQMs no tonal loud', 'RMSE'] <- resultsOutSQMs2$OOB_RMSE
resdHiAnnoyFitAB['Abs SQMs no tonal loud', 'MAE'] <- resultsOutSQMs2$OOB_MAE
resdHiAnnoyFitAB['Abs SQMs no tonal loud', 'Rsquared'] <- resultsOutSQMs2$Rsquared
resdHiAnnoyPermImpAB$AbsSQMs2 <- resultsOutSQMs2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs2.conimp <- arrange(resultsOutSQMs2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs2.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs2.conimp), levels=rownames(resultsOutSQMs2.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 30))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsSQMsNoTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsSQMsNoTonLdConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAbsSQMsNoTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsSQMsNoTonLdConPermimp.pdf")
}
iVars <- c(ambVar, "UASPsychAnnoyWidmann", "UASPsychAnnoyMore", "UASPsychAnnoyDi", "UASPsychAnnoyTorija", "UASPsychAnnoyWillemsen", "UASPsychAnnoyBoucher")
dVar <- "dHighAnnoyPc"
seeds <- c(48651, 45, 785123, 65, 5163)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- 4
Train preliminary model
nperm <- 5
resultsOutPA <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 6.88072
resultsOutPA$OOB_MAE
[1] 5.141535
resultsOutPA$Rsquared
[1] 0.5875095
Train multiple seeds model
resultsOutPA <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 6.879401
resultsOutPA$OOB_MAE
[1] 5.138723
resultsOutPA$Rsquared
[1] 0.5876636
# store results
resdHiAnnoyFitAB['Psychoacoustic annoyance', 'RMSE'] <- resultsOutPA$OOB_RMSE
resdHiAnnoyFitAB['Psychoacoustic annoyance', 'MAE'] <- resultsOutPA$OOB_MAE
resdHiAnnoyFitAB['Psychoacoustic annoyance', 'Rsquared'] <- resultsOutPA$Rsquared
resdHiAnnoyPermImpAB$AbsPA <- resultsOutPA$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutPA.conimp <- arrange(resultsOutPA$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutPA.conimp) + geom_col(aes(x=factor(rownames(resultsOutPA.conimp), levels=rownames(resultsOutPA.conimp)), y=CondPermImp), fill=mycolours[10], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 60))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAbsPAConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAbsPAConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAbsPAConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAbsPAConPermimp.pdf")
}
iVars <- names(stimDataNum)[which(names(stimDataNum) == 'UASEvents'):which(names(stimDataNum) == 'UASPsychAnnoyBoucher')]
iVars <- iVars[! iVars %in% 'SNRlevel']
iVars <- c(iVars,
names(stimDataNum)[which(colnames(stimDataNum)=='LAeqLAF90diff'):
which(colnames(stimDataNum)=='dPsychAnnoyBoucher')], 'SNRlevel')
dVar <- "dHighAnnoyPc"
seeds <- c(2, 312, 1897, 465978, 821659)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1501
mtry <- as.integer(length(iVars)/3.5)
Train preliminary model
nperm <- 5
resultsOutAbsDiffs <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbsDiffs$OOB_RMSE
[1] 6.145585
resultsOutAbsDiffs$OOB_MAE
[1] 4.687502
resultsOutAbsDiffs$Rsquared
[1] 0.6754223
Train multiple seeds model
resultsOutAbsDiffs <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutAbsDiffs$OOB_RMSE
[1] 6.145665
resultsOutAbsDiffs$OOB_MAE
[1] 4.694338
resultsOutAbsDiffs$Rsquared
[1] 0.676116
# store results
resdHiAnnoyFitAB['All vars', 'RMSE'] <- resultsOutAbsDiffs$OOB_RMSE
resdHiAnnoyFitAB['All vars', 'MAE'] <- resultsOutAbsDiffs$OOB_MAE
resdHiAnnoyFitAB['All vars', 'Rsquared'] <- resultsOutAbsDiffs$Rsquared
resdHiAnnoyPermImpAB$AllVars <- resultsOutAbsDiffs$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutAbsDiffs.conimp <- arrange(resultsOutAbsDiffs$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutAbsDiffs.conimp) + geom_col(aes(x=factor(rownames(resultsOutAbsDiffs.conimp), levels=rownames(resultsOutAbsDiffs.conimp)), y=CondPermImp), fill=mycolours[9], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllVarsConPermimp.svg", width=8, height=26, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllVarsConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllVarsConPermimp.pdf", width=8, height=26, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllVarsConPermimp.pdf")
}
# Plot only positive values
resultsOutAbsDiffs.conimpPtv <- resultsOutAbsDiffs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > 0)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbsDiffs.conimpPtv) + geom_col(aes(x=factor(rownames(resultsOutAbsDiffs.conimpPtv), levels=rownames(resultsOutAbsDiffs.conimpPtv)), y=CondPermImp), fill=mycolours[9], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllVarsConPermimpPtv.svg", width=8, height=22, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllVarsConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllVarsConPermimpPtv.pdf", width=8, height=22, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllVarsConPermimp.pdf")
}
# Plot only values within 1% of the maximum
resultsOutAbsDiffs.conimp1pc <- resultsOutAbsDiffs.conimp |>
rownames_to_column('Metric') |>
filter_if(is.numeric, all_vars(. > max(resultsOutAbsDiffs.conimp)/100)) |>
column_to_rownames('Metric')
pBar <- ggplot(resultsOutAbsDiffs.conimp1pc) + geom_col(aes(x=factor(rownames(resultsOutAbsDiffs.conimp1pc), levels=rownames(resultsOutAbsDiffs.conimp1pc)), y=CondPermImp), fill=mycolours[9], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllVarsConPermimp1pc.svg", width=8, height=7, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllVarsConPermimp1pc.svg")
ggsave(filename="PtsABdHiAnnoyAllVarsConPermimp1pc.pdf", width=8, height=7, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllVarsConPermimp1pc.pdf")
}
Selected metric
allVar <- "UASLoudECMAPowAvgBin"
iVars <- c(allVar, eventVar, ambVar, "dSharpAurISO3PowAvgBin", "dSharpAurISO305ExBin", "dSharpAurSHMPowAvgBin", "dSharpAurSHM05ExBin", "dTonShpAurSHMPowAvgBin", "dTonShpAurSHM05ExBin", "PartTonShpAurSHMPowAvgBin",
"PartTonShpAurSHM05ExBin", "UASSharpAurISO3PowAvgBin", "UASSharpAurISO305ExBin", "UASSharpAurSHMPowAvgBin", "UASSharpAurSHM05ExBin", "UASSharpAurISO1PowAvgBin", "UASSharpAurISO105ExBin", "UASSharpvBISO1PowAvgBin", "UASSharpvBISO105ExBin", "UASSharpDINPowAvgBin", "UASSharpDIN05ExBin", "UASSharpAurISO1MedBin",
"UASTonShpAurSHMPowAvgBin", "UASTonShpAurSHM05ExBin")
dVar <- "dHighAnnoyPc"
seeds <- c(84194, 905, 64815, 928054, 625091, 582031)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/2.25)
Train preliminary model
nperm <- 10
resultsOutSharp <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSharp$OOB_RMSE
[1] 6.03978
resultsOutSharp$OOB_MAE
[1] 4.513288
resultsOutSharp$Rsquared
[1] 0.6875739
Train multiple seeds model
resultsOutSharp <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSharp$OOB_RMSE
[1] 6.105942
resultsOutSharp$OOB_MAE
[1] 4.555393
resultsOutSharp$Rsquared
[1] 0.6794885
# store results
resdHiAnnoyFitAB['All sharp', 'RMSE'] <- resultsOutSharp$OOB_RMSE
resdHiAnnoyFitAB['All sharp', 'MAE'] <- resultsOutSharp$OOB_MAE
resdHiAnnoyFitAB['All sharp', 'Rsquared'] <- resultsOutSharp$Rsquared
resdHiAnnoyPermImpAB$AllSharp <- resultsOutSharp$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSharp.conimp <- arrange(resultsOutSharp$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSharp.conimp) + geom_col(aes(x=factor(rownames(resultsOutSharp.conimp), levels=rownames(resultsOutSharp.conimp)), y=CondPermImp), fill=mycolours[2], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("All sharpness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllSharpConPermimp.svg", width=8, height=5, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllSharpConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllSharpConPermimp.pdf", width=8, height=5, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllSharpConPermimp.pdf")
}
Selected metric
allSharpVar <- "dSharpAurSHMPowAvgBin"
iVars <- c(allVar, eventVar, ambVar, "dTonalECMAAvgMaxLR", "dTonalSHMInt05ExMaxLR", "dTonalSHMIntAvgMaxLR", "dTonalECMA05ExMaxLR", "dTonalAwSHMAvgMaxLR", "dTonalAwSHM05ExMaxLR", "dTonalAwSHMIntAvgMaxLR", "dTonalAwSHMInt05ExMaxLR", "dTonLdECMAPowAvgBin", "dTonLdECMA05ExBin", "dTonShpAurSHMPowAvgBin",
"dTonShpAurSHM05ExBin", "PartTonLdSHMPowAvgBin", "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonLdECMAPowAvgBin", "UASTonLdECMA05ExBin", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR",
"UASTonShpAurSHMPowAvgBin", "UASTonShpAurSHM05ExBin")
dVar <- "dHighAnnoyPc"
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
seeds <- c(561684, 104798, 1536, 48, 48561)
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/2.25)
Train preliminary model
# Tonality with tonal loudness
nperm <- 5
resultsOutTonal1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 6.240305
resultsOutTonal1$OOB_MAE
[1] 4.837859
resultsOutTonal1$Rsquared
[1] 0.6655154
Train multiple seeds model
# Tonality with tonal loudness
resultsOutTonal1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal1$OOB_RMSE
[1] 6.300441
resultsOutTonal1$OOB_MAE
[1] 4.883414
resultsOutTonal1$Rsquared
[1] 0.6581737
# store results
resdHiAnnoyFitAB['All tonal inc loud', 'RMSE'] <- resultsOutTonal1$OOB_RMSE
resdHiAnnoyFitAB['All tonal inc loud', 'MAE'] <- resultsOutTonal1$OOB_MAE
resdHiAnnoyFitAB['All tonal inc loud', 'Rsquared'] <- resultsOutTonal1$Rsquared
resdHiAnnoyPermImpAB$AllTonal1 <- resultsOutTonal1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal1.conimp <- arrange(resultsOutTonal1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal1.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal1.conimp), levels=rownames(resultsOutTonal1.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("All tonality inc. tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 50))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllTonalLdConPermimp.svg", width=8, height=6, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllTonalLdConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllTonalLdConPermimp.pdf", width=8, height=6, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllTonalLdConPermimp.pdf")
}
Selected metric
allTonLdVar <- "UASTonLdECMAPowAvgBin"
iVars <- c(allVar, eventVar, ambVar, "dTonalECMAAvgMaxLR", "dTonalSHMInt05ExMaxLR", "dTonalSHMIntAvgMaxLR", "dTonalECMA05ExMaxLR", "dTonalAwSHMAvgMaxLR", "dTonalAwSHM05ExMaxLR", "dTonalAwSHMIntAvgMaxLR", "dTonalAwSHMInt05ExMaxLR", "UASTonalECMAAvgMaxLR", "UASTonalSHMInt05ExMaxLR", "UASTonalSHMIntAvgMaxLR", "UASTonalECMA05ExMaxLR", "UASTonalAwSHMAvgMaxLR", "UASTonalAwSHM05ExMaxLR", "UASTonalAwSHMIntAvgMaxLR", "UASTonalAwSHMInt05ExMaxLR", "UASTonalAurAvgMaxLR", "UASTonalAur05ExMaxLR", "UASTonalAur10ExMaxLR")
dVar <- "dHighAnnoyPc"
seeds <- c(410865, 2954, 70812, 203, 7984)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 501
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
# Tonality
nperm <- 5
resultsOutTonal2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 6.399904
resultsOutTonal2$OOB_MAE
[1] 4.887571
resultsOutTonal2$Rsquared
[1] 0.6451589
Train multiple seeds model
# Tonality
resultsOutTonal2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutTonal2$OOB_RMSE
[1] 6.393998
resultsOutTonal2$OOB_MAE
[1] 4.900818
resultsOutTonal2$Rsquared
[1] 0.6463381
# store results
resdHiAnnoyFitAB['All tonal no loud', 'RMSE'] <- resultsOutTonal2$OOB_RMSE
resdHiAnnoyFitAB['All tonal no loud', 'MAE'] <- resultsOutTonal2$OOB_MAE
resdHiAnnoyFitAB['All tonal no loud', 'Rsquared'] <- resultsOutTonal2$Rsquared
resdHiAnnoyPermImpAB$AllTonal2 <- resultsOutTonal2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutTonal2.conimp <- arrange(resultsOutTonal2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutTonal2.conimp) + geom_col(aes(x=factor(rownames(resultsOutTonal2.conimp), levels=rownames(resultsOutTonal2.conimp)), y=CondPermImp), fill=mycolours[3], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("All tonality w/o tonal loudness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 100))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllTonalConPermimp.svg", width=8, height=4.8, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllTonalConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllTonalConPermimp.pdf", width=8, height=4.8, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllTonalConPermimp.pdf")
}
Selected metric
allTonalVar <- "UASTonalAwSHMInt05ExMaxLR"
# Fluctuation strength
iVars <- c(allVar, eventVar, ambVar, "dFluctECMA10ExBin", "dFluctECMA05ExBin", "dFluctOV10ExMaxLR", "dFluctOV05ExMaxLR", "UASFluctOldSHM10ExBin", "UASFluctOldSHM05ExBin", "UASFluctECMA10ExBin", "UASFluctECMA05ExBin", "UASFluctFZ10ExMaxLR", "UASFluctFZ05ExMaxLR", "UASFluctOV10ExMaxLR", "UASFluctOV05ExMaxLR")
dVar <- "dHighAnnoyPc"
seeds <- c(418657, 84, 1630, 18659, 3687)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 251
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutFluct <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 6.439173
resultsOutFluct$OOB_MAE
[1] 4.789859
resultsOutFluct$Rsquared
[1] 0.6391434
Train multiple seeds model
resultsOutFluct <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutFluct$OOB_RMSE
[1] 6.4464
resultsOutFluct$OOB_MAE
[1] 4.815919
resultsOutFluct$Rsquared
[1] 0.6384767
# store results
resdHiAnnoyFitAB['All fluct', 'RMSE'] <- resultsOutFluct$OOB_RMSE
resdHiAnnoyFitAB['All fluct', 'MAE'] <- resultsOutFluct$OOB_MAE
resdHiAnnoyFitAB['All fluct', 'Rsquared'] <- resultsOutFluct$Rsquared
resdHiAnnoyPermImpAB$AllFluct <- resultsOutFluct$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutFluct.conimp <- arrange(resultsOutFluct$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutFluct.conimp) + geom_col(aes(x=factor(rownames(resultsOutFluct.conimp), levels=rownames(resultsOutFluct.conimp)), y=CondPermImp), fill=mycolours[4], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("All fluctuation strength") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllFluctConPermimp.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllFluctConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllFluctConPermimp.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllFluctConPermimp.pdf")
}
Selected metric
allFluctVar <- "UASFluctECMA10ExBin"
# Roughness
iVars <- c(allVar, eventVar, ambVar, "dRoughECMA10ExBin", "dRoughECMA05ExBin", "dRoughFZ10ExMaxLR", "dRoughFZ05ExMaxLR", "UASRoughECMA10ExBin", "UASRoughECMA05ExBin", "UASRoughFZ10ExMaxLR", "UASRoughFZ05ExMaxLR", "UASRoughDW10ExMaxLR", "UASRoughDW05ExMaxLR")
dVar <- "dHighAnnoyPc"
seeds <- c(69851, 85109, 410986, 1563, 896)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1501
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutRough <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 6.494263
resultsOutRough$OOB_MAE
[1] 4.835709
resultsOutRough$Rsquared
[1] 0.633995
Train multiple seeds model
resultsOutRough <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutRough$OOB_RMSE
[1] 6.495009
resultsOutRough$OOB_MAE
[1] 4.843281
resultsOutRough$Rsquared
[1] 0.6340358
# store results
resdHiAnnoyFitAB['All rough', 'RMSE'] <- resultsOutRough$OOB_RMSE
resdHiAnnoyFitAB['All rough', 'MAE'] <- resultsOutRough$OOB_MAE
resdHiAnnoyFitAB['All rough', 'Rsquared'] <- resultsOutRough$Rsquared
resdHiAnnoyPermImpAB$AllRough <- resultsOutRough$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutRough.conimp <- arrange(resultsOutRough$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutRough.conimp) + geom_col(aes(x=factor(rownames(resultsOutRough.conimp), levels=rownames(resultsOutRough.conimp)), y=CondPermImp), fill=mycolours[5], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("All roughness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllRoughConPermimp.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllRoughConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllRoughConPermimp.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllRoughConPermimp.pdf")
}
Selected metric
allRoughVar <- "dRoughFZ05ExMaxLR"
# Impulsiveness
iVars <- c(allVar, eventVar, ambVar, "dImpulsSHMAvgMaxLR", "dImpulsSHM05ExMaxLR", "dImpulsSHMPowAvgMaxLR",
"dImpulsLoudWZAvgMaxLR", "dImpulsLoudWZ05ExMaxLR", "dImpulsLoudWZPowAvgMaxLR",
"dImpulsLoudWECMAAvgBin", "dImpulsLoudWECMA05ExBin", "dImpulsLoudWECMAPowAvgBin", "UASImpulsSHMAvgMaxLR", "UASImpulsSHM05ExMaxLR", "UASImpulsSHMPowAvgMaxLR", "UASImpulsLoudWZAvgMaxLR", "UASImpulsLoudWZ05ExMaxLR", "UASImpulsLoudWZPowAvgMaxLR", "UASImpulsLoudWECMAAvgBin", "UASImpulsLoudWECMA05ExBin", "UASImpulsLoudWECMAPowAvgBin")
dVar <- "dHighAnnoyPc"
seeds <- c(418659, 7805, 38475, 65834, 1653)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 5501
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutImpuls <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 6.462745
resultsOutImpuls$OOB_MAE
[1] 4.980449
resultsOutImpuls$Rsquared
[1] 0.6423632
Train multiple seeds model
resultsOutImpuls <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutImpuls$OOB_RMSE
[1] 6.478918
resultsOutImpuls$OOB_MAE
[1] 4.979735
resultsOutImpuls$Rsquared
[1] 0.6409678
# store results
resdHiAnnoyFitAB['All impuls', 'RMSE'] <- resultsOutImpuls$OOB_RMSE
resdHiAnnoyFitAB['All impuls', 'MAE'] <- resultsOutImpuls$OOB_MAE
resdHiAnnoyFitAB['All impuls', 'Rsquared'] <- resultsOutImpuls$Rsquared
resdHiAnnoyPermImpAB$AllImpuls <- resultsOutImpuls$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutImpuls.conimp <- arrange(resultsOutImpuls$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutImpuls.conimp) + geom_col(aes(x=factor(rownames(resultsOutImpuls.conimp), levels=rownames(resultsOutImpuls.conimp)), y=CondPermImp), fill=mycolours[6], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + ggtitle("All impulsiveness") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip()
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllImpulsConPermimp.svg", width=8, height=5.6, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllImpulsConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllImpulsConPermimp.pdf", width=8, height=5.6, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllImpulsConPermimp.pdf")
}
Selected metric
allImpulsVar <- "UASImpulsLoudWZAvgMaxLR"
Now the highest importance dSQMs are ranked against each other, controlling for loudness difference.
iVars <- c(allVar, eventVar, ambVar, allSharpVar, allTonLdVar, allFluctVar, allRoughVar, allImpulsVar)
dVar <- "dHighAnnoyPc"
seeds <- c(98465, 54163, 6541, 36485, 849675)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 1001
mtry <- 3
Train preliminary model
nperm <- 5
resultsOutSQMs1 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 6.263055
resultsOutSQMs1$OOB_MAE
[1] 4.827668
resultsOutSQMs1$Rsquared
[1] 0.6595923
Train multiple seeds model
resultsOutSQMs1 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs1$OOB_RMSE
[1] 6.239049
resultsOutSQMs1$OOB_MAE
[1] 4.812234
resultsOutSQMs1$Rsquared
[1] 0.6620318
# store results
resdHiAnnoyFitAB['All SQMs inc tonal loud', 'RMSE'] <- resultsOutSQMs1$OOB_RMSE
resdHiAnnoyFitAB['All SQMs inc tonal loud', 'MAE'] <- resultsOutSQMs1$OOB_MAE
resdHiAnnoyFitAB['All SQMs inc tonal loud', 'Rsquared'] <- resultsOutSQMs1$Rsquared
resdHiAnnoyPermImpAB$AllSQMs1 <- resultsOutSQMs1$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs1.conimp <- arrange(resultsOutSQMs1$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs1.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs1.conimp), levels=rownames(resultsOutSQMs1.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 40))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllSQMsTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllSQMsTonLdConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllSQMsTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllSQMsTonLdConPermimp.pdf")
}
iVars <- c(allVar, eventVar, ambVar, allSharpVar, allTonalVar, allFluctVar, allRoughVar, allImpulsVar)
dVar <- "dHighAnnoyPc"
seeds <- c(49865, 7852, 845961, 410583, 36748)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 2501
mtry <- as.integer(length(iVars)/1.6)
Train preliminary model
nperm <- 5
resultsOutSQMs2 <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 6.438043
resultsOutSQMs2$OOB_MAE
[1] 4.933283
resultsOutSQMs2$Rsquared
[1] 0.6391176
Train multiple seeds model
resultsOutSQMs2 <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutSQMs2$OOB_RMSE
[1] 6.422652
resultsOutSQMs2$OOB_MAE
[1] 4.923783
resultsOutSQMs2$Rsquared
[1] 0.6408381
# store results
resdHiAnnoyFitAB['All SQMs no tonal loud', 'RMSE'] <- resultsOutSQMs2$OOB_RMSE
resdHiAnnoyFitAB['All SQMs no tonal loud', 'MAE'] <- resultsOutSQMs2$OOB_MAE
resdHiAnnoyFitAB['All SQMs no tonal loud', 'Rsquared'] <- resultsOutSQMs2$Rsquared
resdHiAnnoyPermImpAB$AllSQMs2 <- resultsOutSQMs2$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutSQMs2.conimp <- arrange(resultsOutSQMs2$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutSQMs2.conimp) + geom_col(aes(x=factor(rownames(resultsOutSQMs2.conimp), levels=rownames(resultsOutSQMs2.conimp)), y=CondPermImp), fill=mycolours[7], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 40))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllSQMsNoTonLdConPermimp.svg", width=8, height=2.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllSQMsNoTonLdConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllSQMsNoTonLdConPermimp.pdf", width=8, height=2.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllSQMsNoTonLdConPermimp.pdf")
}
iVars <- c(ambVar, "dPsychAnnoyWidmann", "dPsychAnnoyMore", "dPsychAnnoyDi", "dPsychAnnoyTorija", "dPsychAnnoyWillemsen", "dPsychAnnoyBoucher", "UASPsychAnnoyWidmann", "UASPsychAnnoyMore", "UASPsychAnnoyDi", "UASPsychAnnoyTorija", "UASPsychAnnoyWillemsen", "UASPsychAnnoyBoucher")
dVar <- "dHighAnnoyPc"
seeds <- c(835702, 54, 470912, 652, 55297)
p <- mtryTune(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2],
ntrees=ntrees, minsplit=minsplit, minbucket=minbucket)
p
Selected hyperparameters
ntree <- 4001
mtry <- as.integer(length(iVars)/1.25)
Train preliminary model
nperm <- 5
resultsOutPA <- crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds[1:2], ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 6.809738
resultsOutPA$OOB_MAE
[1] 5.143005
resultsOutPA$Rsquared
[1] 0.5960921
Train multiple seeds model
resultsOutPA <- multi_crfReg(dataIn=stimDataNum, iVars=iVars, dVar=dVar, seeds=seeds, ntree=ntree, mtry=mtry, permImpCondThres=permImpCondThres, nperm=nperm, minsplit=minsplit, minbucket=minbucket)
# print model prediction results
resultsOutPA$OOB_RMSE
[1] 6.807571
resultsOutPA$OOB_MAE
[1] 5.140512
resultsOutPA$Rsquared
[1] 0.5963174
# store results
resdHiAnnoyFitAB['All Psychoacoustic annoyance', 'RMSE'] <- resultsOutPA$OOB_RMSE
resdHiAnnoyFitAB['All Psychoacoustic annoyance', 'MAE'] <- resultsOutPA$OOB_MAE
resdHiAnnoyFitAB['All Psychoacoustic annoyance', 'Rsquared'] <- resultsOutPA$Rsquared
resdHiAnnoyPermImpAB$AllPA <- resultsOutPA$conditional_permimp
par(mai=c(0,3,0,0))
# plot conditional importance
resultsOutPA.conimp <- arrange(resultsOutPA$conditional_permimp, desc(row_number()))
pBar <- ggplot(resultsOutPA.conimp) + geom_col(aes(x=factor(rownames(resultsOutPA.conimp), levels=rownames(resultsOutPA.conimp)), y=CondPermImp), fill=mycolours[10], width=0.5) + labs(x="Variable", y="Conditional variable permutation importance (% highly annoyed)") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 70))
pBar
if (saveplots){
ggsave(filename="PtsABdHiAnnoyAllPAConPermimp.svg", width=8, height=4.4, path=file.path(outFigPath, "svg"))
unlink("PtsABdHiAnnoyAllPAConPermimp.svg")
ggsave(filename="PtsABdHiAnnoyAllPAConPermimp.pdf", width=8, height=4.4, path=file.path(outFigPath, "pdf"))
unlink("PtsABdHiAnnoyAllPAConPermimp.pdf")
}
if (savedata){
utils::write.csv(resdHiAnnoyFitAB, paste(outDataPath, "\\PtsABCRFdHiAnnoyOOBFit.csv", sep=""))
ii <- 0
temp = list()
for (res in resdHiAnnoyPermImpAB){
ii <- ii + 1
temp[[ii]] <- as.data.frame(resdHiAnnoyPermImpAB[ii])
names(temp[[ii]]) <- names(resdHiAnnoyPermImpAB[ii])
}
openxlsx::write.xlsx(temp, paste(outDataPath, "\\PtsABCRFdHiAnnoyConPermimp.xlsx",
sep=""),
rowNames=TRUE)
}
Summary of results for Parts A & B combined
# combine the annoyance perm importance results
# convert each result to a tibble with rownames added to a column, renaming the data column to 'dAnnoy' etc.
resdAnnoyMnAbsPermImpTblAB <- as.data.frame(resdAnnoyMnPermImpAB$AbsSQMs1/max(resdAnnoyMnPermImpAB$AbsSQMs1)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdAnnoyMnAbsPermImpTblAB)[2] <- "dAnnoy"
resdHiAnnoyAbsPermImpTblAB <- as.data.frame(resdHiAnnoyPermImpAB$AbsSQMs1/max(resdHiAnnoyPermImpAB$AbsSQMs1)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdHiAnnoyAbsPermImpTblAB)[2] <- "dHiAnnoy"
# merge the dataframes
resAbsPermImpTblAB <- list(resdAnnoyMnAbsPermImpTblAB, resdHiAnnoyAbsPermImpTblAB) |>
purrr::reduce(merge, by = c('Variable'), all = T)
# rename the columns
colnames(resAbsPermImpTblAB)[2:3] <- c("Mean change in annoyance", "%HA | HA' (amb.)")
resAbsPermImpTblAB[is.na(resAbsPermImpTblAB)] <- 0
resAbsAB <- tidyr::pivot_longer(resAbsPermImpTblAB, cols=-Variable, names_to="Outcome", values_to="Imp")
# reorder res tibble, descending by the variable Imp grouped sum and create column with new group order as a factor
resAbsAB <- resAbsAB |> mutate(Variable_sum = sum(Imp), .by=Variable) |> arrange(desc(Variable_sum)) |> group_by(Variable_sum, Variable) |>
mutate(Order = cur_group_id()) |> mutate(Order = as.factor(Order)) |> arrange(desc(Order))
# Reorder outcome levels
resAbsAB$Outcome <- factor(resAbsAB$Outcome, levels=c("Mean change in annoyance", "%HA | HA' (amb.)"))
# plot res as horizontal bar chart, with Imp as y axis, Variable as x axis, Outcome as fill, and Variable_sum as order, relabel x axis with Variable names
pBar <- ggplot(resAbsAB) + geom_col(aes(fill=Outcome, y=Imp, x=Order), colour='grey35', linewidth=0, width=0.75, show.legend=TRUE) + labs(x="Variable", y="Normalised conditional variable\npermutation importance") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2)) + coord_flip(ylim=c(0, 1)) + scale_fill_manual(values=mycolours, labels=c(expression(paste(bar(Delta~A))), "%HA | HA' (amb.)")) + scale_x_discrete(labels=unique(rev(resAbsAB$Variable))) + guides(fill=guide_legend(title='Outcome'))
pBar + scale_y_continuous(breaks=seq(0, 1, by=0.5))
if (saveplots){
ggsave(filename="PtsABcrfAbsSQMsSummary.svg", width=8, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABcrfAbsSQMsSummary.svg")
ggsave(filename="PtsABcrfAbsSQMsSummary.pdf", width=8, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABcrfAbsSQMsSummary.pdf")
}
# plot res as horizontal bar chart, with Imp as y axis, Variable as x axis, Outcome as fill, and Variable_sum as order, relabel x axis with Variable names
pBar <- ggplot(resAbsAB) + geom_col(aes(fill=Outcome, y=Imp, x=Order), colour='grey35', linewidth=0, width=0.75, show.legend=TRUE) + labs(x="Variable", y="Normalised conditional variable\npermutation importance") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2), legend.position = "top") + coord_flip(ylim=c(0, 1)) + scale_fill_manual(values=mycolours, labels=c(expression(paste(bar(Delta~A))), "%HA | HA' (amb.)")) + scale_x_discrete(labels=unique(rev(resAbsAB$Variable))) + guides(fill=guide_legend(title='Outcome', nrow=2, ncol=1))
pBar + scale_y_continuous(breaks=seq(0, 1, by=0.5))
if (saveplots){
ggsave(filename="PtsABcrfAbsSQMsSummaryNw.svg", width=4, height=4, path=file.path(outFigPath, "svg"))
unlink("PtsABcrfAbsSQMsSummary.svg")
ggsave(filename="PtsABcrfAbsSQMsSummaryNw.pdf", width=4, height=4, path=file.path(outFigPath, "pdf"))
unlink("PtsABcrfAbsSQMsSummary.pdf")
}
# combine the annoyance perm importance results
# convert each result to a tibble with rownames added to a column, renaming the data column to 'dAnnoy' etc.
resdAnnoyMnAllPermImpTblAB <- as.data.frame(resdAnnoyMnPermImpAB$AllSQMs1/max(resdAnnoyMnPermImpAB$AllSQMs1)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdAnnoyMnAllPermImpTblAB)[2] <- "dAnnoy"
resdHiAnnoyAllPermImpTblAB <- as.data.frame(resdHiAnnoyPermImpAB$AllSQMs1/max(resdHiAnnoyPermImpAB$AllSQMs1)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdHiAnnoyAllPermImpTblAB)[2] <- "dHiAnnoy"
# merge the dataframes
resAllPermImpTblAB <- list(resdAnnoyMnAllPermImpTblAB, resdHiAnnoyAllPermImpTblAB) |>
purrr::reduce(merge, by = c('Variable'), all = T)
# rename the columns
colnames(resAllPermImpTblAB)[2:3] <- c("Mean change in annoyance", "%HA | HA' (amb.)")
resAllPermImpTblAB[is.na(resAllPermImpTblAB)] <- 0
resAllAB <- tidyr::pivot_longer(resAllPermImpTblAB, cols=-Variable, names_to="Outcome", values_to="Imp")
# reorder res tibble, descending by the variable Imp grouped sum and create column with new group order as a factor
resAllAB <- resAllAB |> mutate(Variable_sum = sum(Imp), .by=Variable) |> arrange(desc(Variable_sum)) |> group_by(Variable_sum, Variable) |>
mutate(Order = cur_group_id()) |> mutate(Order = as.factor(Order)) |> arrange(desc(Order))
# Reorder outcome levels
resAllAB$Outcome <- factor(resAllAB$Outcome, levels=c("Mean change in annoyance", "%HA | HA' (amb.)"))
# plot res as horizontal bar chart, with Imp as y axis, Variable as x axis, Outcome as fill, and Variable_sum as order, relabel x axis with Variable names
pBar <- ggplot(resAllAB) + geom_col(aes(fill=Outcome, y=Imp, x=Order), colour='grey35', linewidth=0, width=0.75, show.legend=TRUE) + labs(x="Variable", y="Normalised conditional variable permutation importance") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2), legend.position = "right") + coord_flip(ylim=c(-0.1, 1.1)) + scale_fill_manual(values=mycolours) + scale_x_discrete(labels=unique(rev(resAllAB$Variable)))
pBar + scale_y_continuous(breaks=seq(0, 1, by=0.5))
if (saveplots){
ggsave(filename="PtsABcrfAllSQMsSummary.svg", width=8, height=3, path=file.path(outFigPath, "svg"))
unlink("PtsABcrfAllSQMsSummary.svg")
ggsave(filename="PtsABcrfAllSQMsSummary.pdf", width=8, height=3, path=file.path(outFigPath, "pdf"))
unlink("PtsABcrfAllSQMsSummary.pdf")
}
# combine the annoyance perm importance results
# convert each result to a tibble with rownames added to a column, renaming the data column to 'dAnnoy' etc.
resdAnnoyMnAbsPermImpNoTonLdTblAB <- as.data.frame(resdAnnoyMnPermImpAB$AbsSQMs2/max(resdAnnoyMnPermImpAB$AbsSQMs2)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdAnnoyMnAbsPermImpNoTonLdTblAB)[2] <- "dAnnoy"
resdHiAnnoyAbsPermImpNoTonLdTblAB <- as.data.frame(resdHiAnnoyPermImpAB$AbsSQMs2/max(resdHiAnnoyPermImpAB$AbsSQMs2)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdHiAnnoyAbsPermImpNoTonLdTblAB)[2] <- "dHiAnnoy"
# merge the dataframes
resAbsPermImpNoTonLdTblAB <- list(resdAnnoyMnAbsPermImpNoTonLdTblAB, resdHiAnnoyAbsPermImpNoTonLdTblAB) |>
purrr::reduce(merge, by = c('Variable'), all = T)
# rename the columns
colnames(resAbsPermImpNoTonLdTblAB)[2:3] <- c("Mean change in annoyance", "%HA | HA' (amb.)")
resAbsPermImpNoTonLdTblAB[is.na(resAbsPermImpNoTonLdTblAB)] <- 0
resAbsNoTonLdAB <- tidyr::pivot_longer(resAbsPermImpNoTonLdTblAB, cols=-Variable, names_to="Outcome", values_to="Imp")
# reorder res tibble, descending by the variable Imp grouped sum and create column with new group order as a factor
resAbsNoTonLdAB <- resAbsNoTonLdAB |> mutate(Variable_sum = sum(Imp), .by=Variable) |> arrange(desc(Variable_sum)) |> group_by(Variable_sum, Variable) |>
mutate(Order = cur_group_id()) |> mutate(Order = as.factor(Order)) |> arrange(desc(Order))
# Reorder outcome levels
resAbsNoTonLdAB$Outcome <- factor(resAbsNoTonLdAB$Outcome, levels=c("Mean change in annoyance", "%HA | HA' (amb.)"))
# plot res as horizontal bar chart, with Imp as y axis, Variable as x axis, Outcome as fill, and Variable_sum as order, relabel x axis with Variable names
pBar <- ggplot(resAbsNoTonLdAB) + geom_col(aes(fill=Outcome, y=Imp, x=Order), colour='grey35', linewidth=0, width=0.75, show.legend=TRUE) + labs(x="Variable", y="Normalised conditional variable permutation importance") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2), legend.position = "right") + coord_flip(ylim=c(-0.1, 1.1)) + scale_fill_manual(values=mycolours) + scale_x_discrete(labels=unique(rev(resAbsNoTonLdAB$Variable)))
pBar + scale_y_continuous(breaks=seq(0, 1, by=0.5))
if (saveplots){
ggsave(filename="PtsABcrfAbsSQMsNoTonLdSummary.svg", width=8, height=3, path=file.path(outFigPath, "svg"))
unlink("PtsABcrfAbsSQMsNoTonLdSummary.svg")
ggsave(filename="PtsABcrfAbsSQMsNoTonLdSummary.pdf", width=8, height=3, path=file.path(outFigPath, "pdf"))
unlink("PtsABcrfAbsSQMsNoTonLdSummary.pdf")
}
# combine the annoyance perm importance results
# convert each result to a tibble with rownames added to a column, renaming the data column to 'dAnnoy' etc.
resdAnnoyMnAllPermImpNoTonLdTblAB <- as.data.frame(resdAnnoyMnPermImpAB$AllSQMs2/max(resdAnnoyMnPermImpAB$AllSQMs2)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdAnnoyMnAllPermImpNoTonLdTblAB)[2] <- "dAnnoy"
resdHiAnnoyAllPermImpNoTonLdTblAB <- as.data.frame(resdHiAnnoyPermImpAB$AllSQMs2/max(resdHiAnnoyPermImpAB$AllSQMs2)) |>
tibble::rownames_to_column(var='Variable')
colnames(resdHiAnnoyAllPermImpNoTonLdTblAB)[2] <- "dHiAnnoy"
# merge the dataframes
resAllPermImpNoTonLdTblAB <- list(resdAnnoyMnAllPermImpNoTonLdTblAB, resdHiAnnoyAllPermImpNoTonLdTblAB) |>
purrr::reduce(merge, by = c('Variable'), all = T)
# rename the columns
colnames(resAllPermImpNoTonLdTblAB)[2:3] <- c("Mean change in annoyance", "%HA | HA' (amb.)")
resAllPermImpNoTonLdTblAB[is.na(resAllPermImpNoTonLdTblAB)] <- 0
resAllNoTonLdAB <- tidyr::pivot_longer(resAllPermImpNoTonLdTblAB, cols=-Variable, names_to="Outcome", values_to="Imp")
# reorder res tibble, descending by the variable Imp grouped sum and create column with new group order as a factor
resAllNoTonLdAB <- resAllNoTonLdAB |> mutate(Variable_sum = sum(Imp), .by=Variable) |> arrange(desc(Variable_sum)) |> group_by(Variable_sum, Variable) |>
mutate(Order = cur_group_id()) |> mutate(Order = as.factor(Order)) |> arrange(desc(Order))
# Reorder outcome levels
resAllNoTonLdAB$Outcome <- factor(resAllNoTonLdAB$Outcome, levels=c("Mean change in annoyance", "%HA | HA' (amb.)"))
# plot res as horizontal bar chart, with Imp as y axis, Variable as x axis, Outcome as fill, and Variable_sum as order, relabel x axis with Variable names
pBar <- ggplot(resAllNoTonLdAB) + geom_col(aes(fill=Outcome, y=Imp, x=Order), colour='grey35', linewidth=0, width=0.75, show.legend=TRUE) + labs(x="Variable", y="Normalised conditional variable permutation importance") + theme(text = element_text(family = "serif"), panel.grid=element_line(color = rgb(235, 235, 235, 100, maxColorValue = 255), linewidth = 0.25, linetype = 2), legend.position = "right") + coord_flip(ylim=c(-0.1, 1.1)) + scale_fill_manual(values=mycolours) + scale_x_discrete(labels=unique(rev(resAllNoTonLdAB$Variable)))
pBar + scale_y_continuous(breaks=seq(0, 1, by=0.5))
if (saveplots){
ggsave(filename="PtsABcrfAllSQMsNoTonLdSummary.svg", width=8, height=3, path=file.path(outFigPath, "svg"))
unlink("PtsABcrfAllSQMsNoTonLdSummary.svg")
ggsave(filename="PtsABcrfAllSQMsNoTonLdSummary.pdf", width=8, height=3, path=file.path(outFigPath, "pdf"))
unlink("PtsABcrfAllSQMsNoTonLdSummary.pdf")
}
# Make a list of the summary results
resSummary <- list(resAbsAB, resAllAB, resAbsNoTonLdAB, resAllNoTonLdAB)
# Save the results
if (savedata){
ii <- 0
temp = list()
for (res in resSummary){
ii <- ii + 1
temp[[ii]] <- data.frame(resSummary[ii])
}
openxlsx::write.xlsx(temp, paste(outDataPath, "\\PtsABCRFSummary.xlsx",
sep=""),
rowNames=TRUE)
}